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, - 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 ===================================== 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); ===================================== 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/-/compare/25132940adf410cfe8ee59bfeb9d0c5cc6625f2a...8fdf97c4e9ea4f62c5dfb97ad10b62d0ba92c855 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25132940adf410cfe8ee59bfeb9d0c5cc6625f2a...8fdf97c4e9ea4f62c5dfb97ad10b62d0ba92c855 You're receiving 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 16:58:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Sep 2020 12:58:50 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 14 commits: testsuite: A few minor perf notes fixes Message-ID: <5f5bacca1b877_80b3f8486c8bfc811593383@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 8546d595 by GHC GitLab CI at 2020-09-11T15:48:25+00:00 testsuite: A few minor perf notes fixes - - - - - ac5a62c6 by Ben Gamari at 2020-09-11T16:00:45+00:00 genprimopcode: Add a second levity-polymorphic tyvar - - - - - 1e15c7f1 by GHC GitLab CI at 2020-09-11T16:00:45+00:00 keepAlive primop - - - - - c28ce393 by Ben Gamari at 2020-09-11T16:00:45+00:00 base: Use keepAlive# in alloca, et al. - - - - - 3da4865f by GHC GitLab CI at 2020-09-11T16:00:45+00:00 Simplify: Factor out runRW rule - - - - - 459dc1da by GHC GitLab CI at 2020-09-11T16:00:45+00:00 Simplify - - - - - 2e1f1254 by GHC GitLab CI at 2020-09-11T16:00: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. - - - - - f41ff8c0 by Ben Gamari at 2020-09-11T16:00:45+00:00 base: Use keepAlive# in withForeignPtr - - - - - 7461cdc1 by GHC GitLab CI at 2020-09-11T16:00:45+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. - - - - - 742f9d60 by GHC GitLab CI at 2020-09-11T16:00:45+00:00 Clarify types of splitFunTy - - - - - 1546c02a by GHC GitLab CI at 2020-09-11T16:00:45+00:00 Lint - - - - - eba1b94a by GHC GitLab CI at 2020-09-11T16:00:46+00:00 Simplify - - - - - c2974e07 by GHC GitLab CI at 2020-09-11T16:00:46+00:00 simplify - - - - - 63f502b4 by GHC GitLab CI at 2020-09-11T16:00:46+00:00 Eliminate spurious ForeignPtrContents allocations - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - 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 - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - utils/genprimopcode/Main.hs 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/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 ===================================== @@ -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,88 @@ 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 }) + | 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 { --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 ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK not-home #-} @@ -24,7 +25,7 @@ module GHC.ForeignPtr ( -- * Types ForeignPtr(..), - ForeignPtrContents(..), + ForeignPtrContents(PlainForeignPtr, FinalPtr, MallocPtr, PlainPtr), Finalizers(..), FinalizerPtr, FinalizerEnvPtr, @@ -46,6 +47,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -79,7 +81,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, @@ -116,11 +118,11 @@ data Finalizers -- > Prohibited | PlainPtr | FinalPtr | -- > +------------+-----------------+ data ForeignPtrContents - = PlainForeignPtr !(IORef Finalizers) + = PlainForeignPtr_ !(IORef Finalizers) -- ^ The pointer refers to unmanaged memory that was allocated by -- a foreign function (typically using @malloc@). The finalizer -- frequently calls the C function @free@ or some variant of it. - | FinalPtr + | FinalPtr_ -- ^ 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 @@ -128,7 +130,7 @@ data ForeignPtrContents -- See Note [Why FinalPtr]. -- -- @since 4.15 - | MallocPtr (MutableByteArray# RealWorld) !(IORef Finalizers) + | MallocPtr_ (MutableByteArray# RealWorld) !(IORef Finalizers) -- ^ The pointer refers to a byte array. -- The 'MutableByteArray#' field means that the 'MutableByteArray#' is -- reachable (by GC) whenever the 'ForeignPtr' is reachable. When the @@ -153,7 +155,7 @@ data ForeignPtrContents -- > incrBad (ForeignPtr p (MallocPtr m _)) = do -- > f <- newIORef NoFinalizers -- > pure (ForeignPtr p (MallocPtr m f)) - | PlainPtr (MutableByteArray# RealWorld) + | PlainPtr_ (MutableByteArray# RealWorld) -- ^ The pointer refers to a byte array. Finalization is not -- supported. This optimizes @MallocPtr@ by avoiding the allocation -- of a @MutVar#@ when it is known that no one will add finalizers to @@ -161,6 +163,31 @@ data ForeignPtrContents -- throw exceptions when the 'ForeignPtr' is backed by 'PlainPtr'. -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well. +plainPtr :: MutableByteArray# RealWorld -> ForeignPtrContents +plainPtr = PlainPtr_ +{-# INLINE [1] plainPtr #-} + +mallocPtr :: MutableByteArray# RealWorld -> IORef Finalizers -> ForeignPtrContents +mallocPtr = MallocPtr_ +{-# INLINE [1] mallocPtr #-} + +finalPtr :: ForeignPtrContents +finalPtr = FinalPtr_ +{-# INLINE [1] finalPtr #-} + +plainForeignPtr :: IORef Finalizers -> ForeignPtrContents +plainForeignPtr = PlainForeignPtr_ +{-# INLINE [1] plainForeignPtr #-} + +pattern PlainPtr mba <- PlainPtr_ mba where + PlainPtr mba = plainPtr mba +pattern MallocPtr mba fin <- MallocPtr_ mba fin where + MallocPtr mba bin = mallocPtr mba bin +pattern FinalPtr <- FinalPtr_ where + FinalPtr = finalPtr +pattern PlainForeignPtr fin <- PlainForeignPtr_ fin where + PlainForeignPtr fin = plainForeignPtr fin + -- Note [Why FinalPtr] -- -- FinalPtr exists as an optimization for foreign pointers created @@ -503,6 +530,39 @@ 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# + +{-# RULES "keepAlive#/PlainForeignPtr" forall s k ref . + keepAlive# (plainForeignPtr ref) s k = keepAlive# ref s k #-} +{-# RULES "keepAlive#/FinalPtr" forall s k . + keepAlive# finalPtr s k = k s #-} +{-# RULES "keepAlive#/MallocPtr" forall s k mba x . + keepAlive# (mallocPtr mba x) s k = keepAlive# mba s k #-} +{-# RULES "keepAlive#/PlainPtr" forall s k mba . + keepAlive# (plainPtr mba) s k = keepAlive# mba s k #-} + 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 e0f2db500f2abd35d2837b9b930d9acfc677be2e ===================================== 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 ===================================== @@ -511,11 +511,7 @@ 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) - 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') + \ @@ -524,6 +520,11 @@ else: else: Perf.append_perf_stat(stats_metrics) + if hasMetricsFile: + 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)) + # Write summary if config.summary_file: with open(config.summary_file, 'w') as f: ===================================== utils/genprimopcode/Main.hs ===================================== @@ -503,6 +503,7 @@ gen_latex_doc (Info defaults entries) tvars = tvars_of typ tbinds [] = ". " tbinds ("o":tbs) = "(o::?) " ++ (tbinds tbs) + tbinds ("p":tbs) = "(p::?) " ++ (tbinds tbs) tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs) tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2 tvars_of (TyC t1 t2) = tvars_of t1 `union` tvars_of t2 @@ -852,6 +853,7 @@ ppTyVar "b" = "betaTyVar" ppTyVar "c" = "gammaTyVar" ppTyVar "s" = "deltaTyVar" ppTyVar "o" = "runtimeRep1TyVar, openAlphaTyVar" +ppTyVar "p" = "runtimeRep2TyVar, openBetaTyVar" ppTyVar _ = error "Unknown type var" ppType :: Ty -> String @@ -885,6 +887,7 @@ ppType (TyVar "b") = "betaTy" ppType (TyVar "c") = "gammaTy" ppType (TyVar "s") = "deltaTy" ppType (TyVar "o") = "openAlphaTy" +ppType (TyVar "p") = "openBetaTy" ppType (TyApp (TyCon "State#") [x]) = "mkStatePrimTy " ++ ppType x ppType (TyApp (TyCon "MutVar#") [x,y]) = "mkMutVarPrimTy " ++ ppType x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad5a0272c76ddd89e1c9ed335cb5bed460121d19...63f502b45c38078c8625d1e453105eb05bf48366 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad5a0272c76ddd89e1c9ed335cb5bed460121d19...63f502b45c38078c8625d1e453105eb05bf48366 You're receiving 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 17:14:19 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 11 Sep 2020 13:14:19 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 472 commits: Define multiShotIO and use it in mkSplitUniqueSupply Message-ID: <5f5bb06b9924_80b3f846730237c11595350@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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. - - - - - 7ef81983 by Moritz Angermann at 2020-09-11T09:03:37+00:00 Initial NCG - - - - - 5a7796f5 by Moritz Angermann at 2020-09-11T09:03:37+00:00 Address Takenobu's comments - - - - - 0656674e by Moritz Angermann at 2020-09-11T09:03:38+00:00 Fix floating points handling of NaNs - - - - - 61ca44f8 by Moritz Angermann at 2020-09-11T09:03:38+00:00 Add basic Graph Coloring support - - - - - 0c971399 by Moritz Angermann at 2020-09-11T09:04:46+00:00 Drop debug - - - - - b0daba4f by Moritz Angermann at 2020-09-11T09:04:46+00:00 Add primops_match.cmm testsuite - - - - - c2427938 by Moritz Angermann at 2020-09-11T09:04:46+00:00 Fix -NaN for real this time. - - - - - c465d5b7 by Moritz Angermann at 2020-09-11T09:04:47+00:00 Adds nan test. - - - - - 54f4176d by Moritz Angermann at 2020-09-11T09:04:47+00:00 no show - - - - - 602cd396 by Moritz Angermann at 2020-09-11T09:04:47+00:00 Some notes on PIC - - - - - 51829bfd by Moritz Angermann at 2020-09-11T09:04:47+00:00 Properly load W32 with bit 31 set. - - - - - b2da0c53 by Moritz Angermann at 2020-09-11T09:04:47+00:00 better relocation logging - - - - - dae133f4 by Moritz Angermann at 2020-09-11T09:06:08+00:00 Add AsmOpt Flags - - - - - dc54bea4 by Moritz Angermann at 2020-09-11T09:06:08+00: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. - - - - - 4ff6f86f by Moritz Angermann at 2020-09-11T09:06:08+00:00 Drop dead 32bit logic. - - - - - 19a25aae by Moritz Angermann at 2020-09-11T09:06:08+00: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. - - - - - dcaecd10 by Moritz Angermann at 2020-09-11T09:06:08+00:00 Drop duplicate show instance for CLabel now. - - - - - af9515a6 by Moritz Angermann at 2020-09-11T09:06:08+00:00 Add link, lest I keep forgetting it. - - - - - 0b8a2b67 by Moritz Angermann at 2020-09-11T09:06:09+00:00 inline comments with // - - - - - 8db1a005 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Some optimizations; not yet sure if safe or not. - - - - - ccd8b1ff by Moritz Angermann at 2020-09-11T09:06:09+00:00 Add latest opt changes. - - - - - fc7751dc by Moritz Angermann at 2020-09-11T09:06:09+00:00 Address Takenobu Tani's comments. Thanks! - - - - - 5df5ff04 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Fix gcd :blush: - - - - - 452cbfaa by Moritz Angermann at 2020-09-11T09:06:09+00:00 Overflow guard - - - - - e39171b8 by Moritz Angermann at 2020-09-11T09:06:09+00:00 More annotations. - - - - - 3f3a5106 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Revert "Overflow guard" They are Integers not Ints. This reverts commit 3ef94e593a2848cf2bdc4251f5be34536642675f. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 87d9951e by Moritz Angermann at 2020-09-11T09:06:09+00:00 Add CmmAssign and CmmStore comments - - - - - 75a8b8dd by Moritz Angermann at 2020-09-11T09:06:09+00:00 Minor address mode changes - - - - - ccdeada6 by Moritz Angermann at 2020-09-11T09:06:09+00:00 More Amode optimizations - - - - - a08472ed by Moritz Angermann at 2020-09-11T09:06:09+00:00 I think this shoudl work for all Registers, not just CmmGlobal - - - - - 2e482aa6 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Opt <<, >> - - - - - 533d7ead by Moritz Angermann at 2020-09-11T09:06:09+00:00 Opt &&, || - - - - - f3f00f3d by Moritz Angermann at 2020-09-11T09:06:09+00:00 Add branch ANNotations. - - - - - d4f86ab6 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Disable Opt &&, ||, due to mask immediate - - - - - 78c4c3a1 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Opt: Adds CBZ, CBNZ - - - - - f5ef01dd by Moritz Angermann at 2020-09-11T09:06:09+00:00 More generic CBZ, CBNZ - - - - - 182df0a4 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Fixup - - - - - 47ad7c3e by Moritz Angermann at 2020-09-11T09:06:09+00:00 very rudimentary bitmask support. - - - - - 8c84d334 by Moritz Angermann at 2020-09-11T09:06:09+00:00 Add some more bitmasks - - - - - 6a7979fe by Moritz Angermann at 2020-09-11T09:06:09+00:00 Opt STR - - - - - da00b3cc by Moritz Angermann at 2020-09-11T09:06:09+00:00 Fixup - - - - - 5af8c54e by Moritz Angermann at 2020-09-11T09:06:09+00:00 Fix MO_SF_Conv - - - - - 52ddccc5 by Moritz Angermann at 2020-09-11T09:06:10+00:00 Add Comment re MO_Memcpy - - - - - 652e5863 by Moritz Angermann at 2020-09-11T09:06:10+00:00 Always PIC via GOT - - - - - caecbf2c by Moritz Angermann at 2020-09-11T09:06:10+00:00 Fix up generated assembly. Don't generate identity moves e.g. mov x18, x18 - - - - - ded2fd3b by Moritz Angermann at 2020-09-11T09:06:10+00:00 Drop superfulous alignment generation. - - - - - 1296bbfb by Moritz Angermann at 2020-09-11T09:07:04+00:00 Hadrian :fire: - - - - - 605c1513 by Moritz Angermann at 2020-09-11T09:07:04+00:00 Address Tekenobus comments. Thanks! - - - - - fe53e92f by Moritz Angermann at 2020-09-11T09:07:04+00:00 Adds J to distinguish jumps from B. Maybe this would be better handled with a phantom type? - - - - - 5bafa3d4 by Moritz Angermann at 2020-09-11T09:07:04+00:00 Make sp an Operand - - - - - 1e8b1810 by Moritz Angermann at 2020-09-11T09:07:04+00: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. - - - - - ab12fdc4 by Moritz Angermann at 2020-09-11T09:08:39+00:00 [Spill/Reload] Spill Around :fire: - - - - - 1a5e310d by Moritz Angermann at 2020-09-11T09:08:39+00:00 Address Takenobus observations! Thanks! - - - - - b32a0f67 by Moritz Angermann at 2020-09-11T09:08:39+00:00 :sob: - - - - - 61ca1a0e by Moritz Angermann at 2020-09-11T09:09:21+00: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 - - - - - 2b2c4844 by Moritz Angermann at 2020-09-11T09:09:21+00:00 Disable trivial deadlock detection - - - - - 7c6023ca by Moritz Angermann at 2020-09-11T09:09:21+00:00 Adds some annotations - - - - - 84b7b213 by Moritz Angermann at 2020-09-11T09:09:21+00:00 Trying to get PIC right. - - - - - 4b300b20 by Moritz Angermann at 2020-09-11T09:11:06+00:00 [aarch64] Fix spill/reload - - - - - 9abb259b by Moritz Angermann at 2020-09-11T09:11:06+00:00 Try to get PIC right. - - - - - b2dc4312 by Moritz Angermann at 2020-09-11T09:11:06+00:00 Spill/Reload only need a smaller window - - - - - 2244dd87 by Moritz Angermann at 2020-09-11T09:11:06+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. - - - - - 09d72efc by Moritz Angermann at 2020-09-11T09:11:06+00:00 B is b - - - - - 1a2c778b by Moritz Angermann at 2020-09-11T09:11:06+00:00 Fix CCall |Now mark used registers properly for the Register Allocator. - - - - - 0c680870 by Moritz Angermann at 2020-09-11T09:11:06+00:00 :sob: - - - - - b9846e0c by Moritz Angermann at 2020-09-11T09:11:06+00:00 :sob: :sob: - - - - - c05b87b6 by Moritz Angermann at 2020-09-11T09:11:06+00:00 :sob: Segfault no 3. This showed up in T4114 - - - - - c08976bd by Moritz Angermann at 2020-09-11T09:14:25+00:00 Add mkComment to `Instruction` - - - - - d77efe2d by Moritz Angermann at 2020-09-11T09:14:25+00:00 Use mkComment for debugging - - - - - 8990b166 by Moritz Angermann at 2020-09-11T09:14:25+00:00 Fix T4114 crashes T4114 causes this codepath to show up. - - - - - d8a5f375 by Moritz Angermann at 2020-09-11T09:14:49+00:00 Cleanup some compiler warnings - - - - - 5ab1b6cd by Moritz Angermann at 2020-09-11T09:14:49+00:00 [Aarch64] No div-by-zero; disable test. - - - - - f27472c0 by Moritz Angermann at 2020-09-11T09:14: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 - - - - - 505b9db5 by Moritz Angermann at 2020-09-11T09:14:50+00:00 Use ip0 for spills/reloads - - - - - 56f27362 by Moritz Angermann at 2020-09-11T09:15:32+00:00 :broom: Cleanup imports/unused args - - - - - 67c32b35 by Moritz Angermann at 2020-09-11T09:16:17+00:00 :broom: :dash: - - - - - 64c698d8 by Moritz Angermann at 2020-09-11T17:09:09+00:00 Rebase onto master; cleanup - - - - - 28 changed files: - .gitignore - .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/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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb3db8938347b148a4b5dd7b3d1fbf1282d12a21...64c698d8aa6d445d4192af17c9bb78afbf1440eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb3db8938347b148a4b5dd7b3d1fbf1282d12a21...64c698d8aa6d445d4192af17c9bb78afbf1440eb You're receiving 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 18:01:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Sep 2020 14:01:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Define TICKY_TICKY when compiling cmm RTS files. Message-ID: <5f5bbb7482db4_80b3f84271305e81160945c@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job 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. - - - - - 3dc3b554 by Sandy Maguire at 2020-09-11T14:01:15-04:00 Add clamp function to Data.Ord - - - - - 24e151d5 by Sandy Maguire at 2020-09-11T14:01:15-04:00 Add tests - - - - - 09baaae5 by Ben Gamari at 2020-09-11T14:01:15-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 820c2ed6 by Ryan Scott at 2020-09-11T14:01:16-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 822fb6e6 by Krzysztof Gogolewski at 2020-09-11T14:01:16-04:00 Make sure we can read past perf notes See #18656. - - - - - b4496a44 by Ben Gamari at 2020-09-11T14:01:16-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - dcc95cb7 by Ben Gamari at 2020-09-11T14:01:16-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - ecfa8b69 by Ben Gamari at 2020-09-11T14:01:16-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 24 changed files: - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - hadrian/src/Builder.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/stg/Ticky.h - libraries/Cabal - libraries/base/Data/Ord.hs - libraries/base/tests/all.T - + libraries/base/tests/clamp.hs - + libraries/base/tests/clamp.stdout - libraries/directory - libraries/haskeline - mk/ways.mk - rts/Ticky.c - rts/win32/IOManager.c - rts/win32/WorkQueue.c - testsuite/driver/perf_notes.py - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/ghc-cabal.cabal - utils/haddock 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.* ===================================== 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/src/Builder.hs ===================================== @@ -287,7 +287,7 @@ instance H.Builder Builder where cmd' echo [path] "--no-split" [ "-o", output] [input] Xelatex -> unit $ cmd' [Cwd output] [path] buildArgs - Makeindex -> unit $ cmd' [Cwd output] [path] buildArgs + Makeindex -> unit $ cmd' [Cwd output] [path] (buildArgs ++ [input]) Tar _ -> cmd' buildOptions echo [path] buildArgs _ -> cmd' echo [path] buildArgs ===================================== 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. ] ===================================== 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 ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb ===================================== libraries/base/Data/Ord.hs ===================================== @@ -21,6 +21,7 @@ module Data.Ord ( Ordering(..), Down(..), comparing, + clamp, ) where import Data.Bits (Bits, FiniteBits) @@ -44,6 +45,25 @@ import GHC.Show comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) +-- | +-- > clamp (low, high) a = min high (max a low) +-- +-- Function for ensursing the value @a@ is within the inclusive bounds given by +-- @low@ and @high at . If it is, @a@ is returned unchanged. The result +-- is otherwise @low@ if @a <= low@, or @high@ if @high <= a at . +-- +-- When clamp is used at Double and Float, it has NaN propagating semantics in +-- its second argument. That is, @clamp (l,h) NaN = NaN@, but @clamp (NaN, NaN) +-- x = x at . +-- +-- >>> clamp (0, 10) 2 +-- 2 +-- +-- >>> clamp ('a', 'm') 'x' +-- 'm' +clamp :: (Ord a) => (a, a) -> a -> a +clamp (low, high) a = min high (max a low) + -- | The 'Down' type allows you to reverse sort order conveniently. A value of type -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@). -- If @a@ has an @'Ord'@ instance associated with it then comparing two ===================================== libraries/base/tests/all.T ===================================== @@ -256,3 +256,4 @@ test('T16943a', normal, compile_and_run, ['']) test('T16943b', normal, compile_and_run, ['']) test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w']) test('T16643', normal, compile_and_run, ['']) +test('clamp', normal, compile_and_run, ['']) ===================================== libraries/base/tests/clamp.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Ord + +doClampInt :: (Int, Int) -> Int -> IO () +doClampInt bounds a = print $ clamp bounds a + +doClampFloat :: (Float, Float) -> Float -> IO () +doClampFloat bounds a = print $ clamp bounds a + +nan :: Float +nan = 0 / 0 + +main :: IO () +main = do + doClampInt (0, 100) 50 -- 50 + doClampInt (0, 100) 200 -- 100 + doClampInt (0, 100) (-5) -- 0 + + doClampFloat (0, 100) 50 -- 50 + doClampFloat (0, 100) 200 -- 100 + doClampFloat (0, 100) (-5) -- 0 + doClampFloat (0, 100) nan -- NaN + doClampFloat (nan, 100) 5 -- 5 + doClampFloat (nan, 100) 105 -- 100 + doClampFloat (5, nan) 105 -- 105 + doClampFloat (5, nan) 3 -- 5 + + doClampFloat (nan, nan) 3 -- 3 + ===================================== libraries/base/tests/clamp.stdout ===================================== @@ -0,0 +1,12 @@ +50 +100 +0 +50.0 +100.0 +0.0 +NaN +5.0 +100.0 +105.0 +5.0 +3.0 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 5f16b76168f13c6413413386efc44fb1152048d5 +Subproject commit 0f8d5b73a0cbabea6d1b88a5fc2f06ea219a7bea ===================================== 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); ===================================== 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/driver/perf_notes.py ===================================== @@ -130,7 +130,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. @@ -662,6 +668,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: ===================================== 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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38de0f2a41e81fe43bdb605a8f763bd9bdfe48c...ecfa8b69f69d76034e0fad56f22d241bd7a74692 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38de0f2a41e81fe43bdb605a8f763bd9bdfe48c...ecfa8b69f69d76034e0fad56f22d241bd7a74692 You're receiving 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 23:31:44 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Sep 2020 19:31:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add clamp function to Data.Ord Message-ID: <5f5c08e0f03c9_80b3f840297140c11654614@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 232ce232 by Sandy Maguire at 2020-09-11T19:31:28-04:00 Add clamp function to Data.Ord - - - - - ab327e3e by Sandy Maguire at 2020-09-11T19:31:28-04:00 Add tests - - - - - 1d74afaf by Sebastian Graf at 2020-09-11T19:31:29-04: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 - - - - - 8e0ee8e9 by Ben Gamari at 2020-09-11T19:31:29-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 2be53660 by Ryan Scott at 2020-09-11T19:31:29-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 96800cff by Krzysztof Gogolewski at 2020-09-11T19:31:29-04:00 Make sure we can read past perf notes See #18656. - - - - - 29 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/Builder.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/Data/Ord.hs - libraries/base/tests/all.T - + libraries/base/tests/clamp.hs - + libraries/base/tests/clamp.stdout - testsuite/driver/perf_notes.py - 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, - 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 ===================================== hadrian/src/Builder.hs ===================================== @@ -287,7 +287,7 @@ instance H.Builder Builder where cmd' echo [path] "--no-split" [ "-o", output] [input] Xelatex -> unit $ cmd' [Cwd output] [path] buildArgs - Makeindex -> unit $ cmd' [Cwd output] [path] buildArgs + Makeindex -> unit $ cmd' [Cwd output] [path] (buildArgs ++ [input]) Tar _ -> cmd' buildOptions echo [path] buildArgs _ -> cmd' echo [path] buildArgs ===================================== 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. ] ===================================== libraries/base/Data/Ord.hs ===================================== @@ -21,6 +21,7 @@ module Data.Ord ( Ordering(..), Down(..), comparing, + clamp, ) where import Data.Bits (Bits, FiniteBits) @@ -44,6 +45,25 @@ import GHC.Show comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) +-- | +-- > clamp (low, high) a = min high (max a low) +-- +-- Function for ensursing the value @a@ is within the inclusive bounds given by +-- @low@ and @high at . If it is, @a@ is returned unchanged. The result +-- is otherwise @low@ if @a <= low@, or @high@ if @high <= a at . +-- +-- When clamp is used at Double and Float, it has NaN propagating semantics in +-- its second argument. That is, @clamp (l,h) NaN = NaN@, but @clamp (NaN, NaN) +-- x = x at . +-- +-- >>> clamp (0, 10) 2 +-- 2 +-- +-- >>> clamp ('a', 'm') 'x' +-- 'm' +clamp :: (Ord a) => (a, a) -> a -> a +clamp (low, high) a = min high (max a low) + -- | The 'Down' type allows you to reverse sort order conveniently. A value of type -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@). -- If @a@ has an @'Ord'@ instance associated with it then comparing two ===================================== libraries/base/tests/all.T ===================================== @@ -256,3 +256,4 @@ test('T16943a', normal, compile_and_run, ['']) test('T16943b', normal, compile_and_run, ['']) test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w']) test('T16643', normal, compile_and_run, ['']) +test('clamp', normal, compile_and_run, ['']) ===================================== libraries/base/tests/clamp.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Ord + +doClampInt :: (Int, Int) -> Int -> IO () +doClampInt bounds a = print $ clamp bounds a + +doClampFloat :: (Float, Float) -> Float -> IO () +doClampFloat bounds a = print $ clamp bounds a + +nan :: Float +nan = 0 / 0 + +main :: IO () +main = do + doClampInt (0, 100) 50 -- 50 + doClampInt (0, 100) 200 -- 100 + doClampInt (0, 100) (-5) -- 0 + + doClampFloat (0, 100) 50 -- 50 + doClampFloat (0, 100) 200 -- 100 + doClampFloat (0, 100) (-5) -- 0 + doClampFloat (0, 100) nan -- NaN + doClampFloat (nan, 100) 5 -- 5 + doClampFloat (nan, 100) 105 -- 100 + doClampFloat (5, nan) 105 -- 105 + doClampFloat (5, nan) 3 -- 5 + + doClampFloat (nan, nan) 3 -- 3 + ===================================== libraries/base/tests/clamp.stdout ===================================== @@ -0,0 +1,12 @@ +50 +100 +0 +50.0 +100.0 +0.0 +NaN +5.0 +100.0 +105.0 +5.0 +3.0 ===================================== testsuite/driver/perf_notes.py ===================================== @@ -130,7 +130,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. @@ -662,6 +668,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: ===================================== 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/-/compare/ecfa8b69f69d76034e0fad56f22d241bd7a74692...96800cfff5e31a3460820ba39fb136556893581f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecfa8b69f69d76034e0fad56f22d241bd7a74692...96800cfff5e31a3460820ba39fb136556893581f You're receiving 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 12 04:31:42 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 00:31:42 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add clamp function to Data.Ord Message-ID: <5f5c4f2e5f506_80b115f4a5411669267@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 4 changed files: - libraries/base/Data/Ord.hs - libraries/base/tests/all.T - + libraries/base/tests/clamp.hs - + libraries/base/tests/clamp.stdout Changes: ===================================== libraries/base/Data/Ord.hs ===================================== @@ -21,6 +21,7 @@ module Data.Ord ( Ordering(..), Down(..), comparing, + clamp, ) where import Data.Bits (Bits, FiniteBits) @@ -44,6 +45,25 @@ import GHC.Show comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering comparing p x y = compare (p x) (p y) +-- | +-- > clamp (low, high) a = min high (max a low) +-- +-- Function for ensursing the value @a@ is within the inclusive bounds given by +-- @low@ and @high at . If it is, @a@ is returned unchanged. The result +-- is otherwise @low@ if @a <= low@, or @high@ if @high <= a at . +-- +-- When clamp is used at Double and Float, it has NaN propagating semantics in +-- its second argument. That is, @clamp (l,h) NaN = NaN@, but @clamp (NaN, NaN) +-- x = x at . +-- +-- >>> clamp (0, 10) 2 +-- 2 +-- +-- >>> clamp ('a', 'm') 'x' +-- 'm' +clamp :: (Ord a) => (a, a) -> a -> a +clamp (low, high) a = min high (max a low) + -- | The 'Down' type allows you to reverse sort order conveniently. A value of type -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@). -- If @a@ has an @'Ord'@ instance associated with it then comparing two ===================================== libraries/base/tests/all.T ===================================== @@ -256,3 +256,4 @@ test('T16943a', normal, compile_and_run, ['']) test('T16943b', normal, compile_and_run, ['']) test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w']) test('T16643', normal, compile_and_run, ['']) +test('clamp', normal, compile_and_run, ['']) ===================================== libraries/base/tests/clamp.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Ord + +doClampInt :: (Int, Int) -> Int -> IO () +doClampInt bounds a = print $ clamp bounds a + +doClampFloat :: (Float, Float) -> Float -> IO () +doClampFloat bounds a = print $ clamp bounds a + +nan :: Float +nan = 0 / 0 + +main :: IO () +main = do + doClampInt (0, 100) 50 -- 50 + doClampInt (0, 100) 200 -- 100 + doClampInt (0, 100) (-5) -- 0 + + doClampFloat (0, 100) 50 -- 50 + doClampFloat (0, 100) 200 -- 100 + doClampFloat (0, 100) (-5) -- 0 + doClampFloat (0, 100) nan -- NaN + doClampFloat (nan, 100) 5 -- 5 + doClampFloat (nan, 100) 105 -- 100 + doClampFloat (5, nan) 105 -- 105 + doClampFloat (5, nan) 3 -- 5 + + doClampFloat (nan, nan) 3 -- 3 + ===================================== libraries/base/tests/clamp.stdout ===================================== @@ -0,0 +1,12 @@ +50 +100 +0 +50.0 +100.0 +0.0 +NaN +5.0 +100.0 +105.0 +5.0 +3.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a5a91cb67e8c4e2558031c04efccf3c378ba254...fb6e29e8d19deaf7581fdef14adc88a02573c83e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a5a91cb67e8c4e2558031c04efccf3c378ba254...fb6e29e8d19deaf7581fdef14adc88a02573c83e You're receiving 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 12 04:32:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 00:32:25 -0400 Subject: [Git][ghc/ghc][master] PmCheck: Disattach COMPLETE pragma lookup from TyCons Message-ID: <5f5c4f5961263_80b3f8494255f001167713@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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, @@ -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, - 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/2a9422859e0c079aaa38bb9a760034f887501fce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a9422859e0c079aaa38bb9a760034f887501fce You're receiving 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 12 04:32:55 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 00:32:55 -0400 Subject: [Git][ghc/ghc][master] hadrian: Pass input file to makeindex Message-ID: <5f5c4f7742b05_80b3f8434f6e85011683024@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 1 changed file: - hadrian/src/Builder.hs Changes: ===================================== hadrian/src/Builder.hs ===================================== @@ -287,7 +287,7 @@ instance H.Builder Builder where cmd' echo [path] "--no-split" [ "-o", output] [input] Xelatex -> unit $ cmd' [Cwd output] [path] buildArgs - Makeindex -> unit $ cmd' [Cwd output] [path] buildArgs + Makeindex -> unit $ cmd' [Cwd output] [path] (buildArgs ++ [input]) Tar _ -> cmd' buildOptions echo [path] buildArgs _ -> cmd' echo [path] buildArgs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/389a668343c0d4f5fa095112ff98d0da6998e99d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/389a668343c0d4f5fa095112ff98d0da6998e99d You're receiving 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 12 04:33:33 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 00:33:33 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Don't quote argument to Hadrian's test-env flag (#18656) Message-ID: <5f5c4f9d1fcf_80b3f84642b488c116884db@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2 changed files: - hadrian/src/Settings/Builders/RunTest.hs - testsuite/driver/perf_notes.py Changes: ===================================== 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. ] ===================================== testsuite/driver/perf_notes.py ===================================== @@ -130,7 +130,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. @@ -662,6 +668,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/389a668343c0d4f5fa095112ff98d0da6998e99d...8440b5fa1397940f2f293935927e690b34110a73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/389a668343c0d4f5fa095112ff98d0da6998e99d...8440b5fa1397940f2f293935927e690b34110a73 You're receiving 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 12 10:54:04 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Sat, 12 Sep 2020 06:54:04 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 2 commits: Cleanup Message-ID: <5f5ca8cca1afe_80b3f84289c2fc0117023b7@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: ec59228d by Moritz Angermann at 2020-09-12T06:49:31+00:00 Cleanup Also align with the new CmmToAsm module layout. - - - - - e8060bf8 by Moritz Angermann at 2020-09-12T10:53:53+00:00 Adds missing module - - - - - 7 changed files: - compiler/GHC/CmmToAsm.hs - + compiler/GHC/CmmToAsm/AArch64.hs - 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.cabal.in Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -83,12 +83,7 @@ import GHC.Prelude import qualified GHC.CmmToAsm.X86 as X86 import qualified GHC.CmmToAsm.PPC as PPC import qualified GHC.CmmToAsm.SPARC as SPARC - -import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64.CodeGen -import qualified GHC.CmmToAsm.AArch64.Regs as AArch64.Regs -import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64.RegInfo -import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.Instr -import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64.Ppr +import qualified GHC.CmmToAsm.AArch64 as AArch64 import GHC.CmmToAsm.Reg.Liveness import qualified GHC.CmmToAsm.Reg.Linear as Linear @@ -168,50 +163,13 @@ nativeCodeGen dflags this_mod modLoc h us cmms ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64" ArchS390X -> panic "nativeCodeGen: No NCG for S390X" ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" - ArchAArch64 -> nCG' (aarch64NcgImpl config) + ArchAArch64 -> nCG' (AArch64.ncgAArch64 config) ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" -aarch64NcgImpl :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr.Instr AArch64.RegInfo.JumpDest -aarch64NcgImpl config - = NcgImpl { - ncgConfig = config - ,cmmTopCodeGen = AArch64.CodeGen.cmmTopCodeGen - ,generateJumpTableForInstr = AArch64.CodeGen.generateJumpTableForInstr config - ,getJumpDestBlockId = AArch64.RegInfo.getJumpDestBlockId - ,canShortcut = AArch64.RegInfo.canShortcut - ,shortcutStatics = AArch64.RegInfo.shortcutStatics - ,shortcutJump = AArch64.RegInfo.shortcutJump - ,pprNatCmmDecl = AArch64.Ppr.pprNatCmmDecl config - ,maxSpillSlots = AArch64.Instr.maxSpillSlots config - ,allocatableRegs = AArch64.Regs.allocatableRegs platform - ,ncgAllocMoreStack = AArch64.Instr.allocMoreStack platform - ,ncgExpandTop = id - ,ncgMakeFarBranches = const id - ,extractUnwindPoints = const [] - ,invertCondBranches = \_ _ -> id - } - where - platform = ncgPlatform config --- --- Allocating more stack space for spilling is currently only --- supported for the linear register allocator on x86/x86_64, the rest --- default to the panic below. To support allocating extra stack on --- more platforms provide a definition of ncgAllocMoreStack. --- -noAllocMoreStack :: Int -> NatCmmDecl statics instr - -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]) -noAllocMoreStack amount _ - = panic $ "Register allocator: out of stack slots (need " ++ show amount ++ ")\n" - ++ " If you are trying to compile SHA1.hs from the crypto library then this\n" - ++ " is a known limitation in the linear allocator.\n" - ++ "\n" - ++ " Try enabling the graph colouring allocator with -fregs-graph instead." - ++ " You can still file a bug report if you like.\n" - -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. data NativeGenAcc statics instr ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for x86 and x86-64 architectures +module GHC.CmmToAsm.AArch64 + ( ncgAArch64 ) +where + +import GHC.Prelude + +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types + +import qualified GHC.CmmToAsm.AArch64.Instr as AArch64 +import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64 +import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64 +import qualified GHC.CmmToAsm.AArch64.Regs as AArch64 +import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64 + +ncgAArch64 :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr AArch64.JumpDest +ncgAArch64 config + = NcgImpl { + ncgConfig = config + ,cmmTopCodeGen = AArch64.cmmTopCodeGen + ,generateJumpTableForInstr = AArch64.generateJumpTableForInstr config + ,getJumpDestBlockId = AArch64.getJumpDestBlockId + ,canShortcut = AArch64.canShortcut + ,shortcutStatics = AArch64.shortcutStatics + ,shortcutJump = AArch64.shortcutJump + ,pprNatCmmDecl = AArch64.pprNatCmmDecl config + ,maxSpillSlots = AArch64.maxSpillSlots config + ,allocatableRegs = AArch64.allocatableRegs platform + ,ncgAllocMoreStack = AArch64.allocMoreStack platform + ,ncgExpandTop = id + ,ncgMakeFarBranches = const id + ,extractUnwindPoints = const [] + ,invertCondBranches = \_ _ -> id + } + where + platform = ncgPlatform config + +-- | Instruction instance for aarch64 +instance Instruction AArch64.Instr where + regUsageOfInstr = AArch64.regUsageOfInstr + patchRegsOfInstr = AArch64.patchRegsOfInstr + isJumpishInstr = AArch64.isJumpishInstr + jumpDestsOfInstr = AArch64.jumpDestsOfInstr + patchJumpInstr = AArch64.patchJumpInstr + mkSpillInstr = AArch64.mkSpillInstr + mkLoadInstr = AArch64.mkLoadInstr + takeDeltaInstr = AArch64.takeDeltaInstr + isMetaInstr = AArch64.isMetaInstr + mkRegRegMoveInstr _ = AArch64.mkRegRegMoveInstr + takeRegRegMoveInstr = AArch64.takeRegRegMoveInstr + mkJumpInstr = AArch64.mkJumpInstr + mkStackAllocInstr = AArch64.mkStackAllocInstr + mkStackDeallocInstr = AArch64.mkStackDeallocInstr + mkComment = pure . AArch64.COMMENT + pprInstr = AArch64.pprInstr ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -27,7 +27,7 @@ import GHC.CmmToAsm.Monad , getPicBaseMaybeNat, getPlatform, getConfig , getDebugBlock, getFileId ) -import GHC.CmmToAsm.Instr +-- import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config @@ -337,15 +337,15 @@ isIntFormat = not . isFloatFormat -- ----------------------------------------------------------------------------- -- General things for putting together code sequences --- Expand CmmRegOff. ToDo: should we do it this way around, or convert --- CmmExprs into CmmRegOff? -mangleIndexTree :: Platform -> CmmExpr -> CmmExpr -mangleIndexTree platform (CmmRegOff reg off) - = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType platform reg) +-- -- Expand CmmRegOff. ToDo: should we do it this way around, or convert +-- -- CmmExprs into CmmRegOff? +-- mangleIndexTree :: Platform -> CmmExpr -> CmmExpr +-- mangleIndexTree platform (CmmRegOff reg off) +-- = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] +-- where width = typeWidth (cmmRegType platform reg) -mangleIndexTree _ _ - = panic "AArch64.CodeGen.mangleIndexTree: no match" +-- mangleIndexTree _ _ +-- = panic "AArch64.CodeGen.mangleIndexTree: no match" -- | The dual to getAnyReg: compute an expression into a register, but -- we don't mind which one it is. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# language CPP, BangPatterns #-} module GHC.CmmToAsm.AArch64.Instr @@ -11,7 +12,7 @@ import GHC.Prelude import GHC.CmmToAsm.AArch64.Cond import GHC.CmmToAsm.AArch64.Regs -import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Instr (RegUsage(..)) import GHC.CmmToAsm.Format import GHC.CmmToAsm.Types import GHC.CmmToAsm.Utils @@ -69,24 +70,6 @@ spillSlotToOffset :: NCGConfig -> Int -> Int spillSlotToOffset config slot = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot --- | Instruction instance for powerpc -instance Instruction Instr where - regUsageOfInstr = aarch64_regUsageOfInstr - patchRegsOfInstr = aarch64_patchRegsOfInstr - isJumpishInstr = aarch64_isJumpishInstr - jumpDestsOfInstr = aarch64_jumpDestsOfInstr - patchJumpInstr = aarch64_patchJumpInstr - mkSpillInstr = aarch64_mkSpillInstr - mkLoadInstr = aarch64_mkLoadInstr - takeDeltaInstr = aarch64_takeDeltaInstr - isMetaInstr = aarch64_isMetaInstr - mkRegRegMoveInstr _ = aarch64_mkRegRegMoveInstr - takeRegRegMoveInstr = aarch64_takeRegRegMoveInstr - 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. -- Just state precisely the regs read and written by that insn. @@ -98,9 +81,9 @@ instance Instruction Instr where instance Outputable RegUsage where ppr (RU reads writes) = text "RegUsage(reads:" <+> ppr reads <> comma <+> text "writes:" <+> ppr writes <> char ')' -aarch64_regUsageOfInstr :: Platform -> Instr -> RegUsage -aarch64_regUsageOfInstr platform instr = case instr of - ANN _ i -> aarch64_regUsageOfInstr platform i +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of + ANN _ i -> regUsageOfInstr platform i -- 1. Arithmetic Instructions ------------------------------------------------ ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) CMN l r -> usage (regOp l ++ regOp r, []) @@ -220,10 +203,10 @@ callerSavedRegisters -- | Apply a given mapping to all the register references in this -- instruction. -aarch64_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr -aarch64_patchRegsOfInstr instr env = case instr of +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (aarch64_patchRegsOfInstr i env) + ANN d i -> ANN d (patchRegsOfInstr i env) -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) @@ -281,7 +264,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) + _ -> pprPanic "patchRegsOfInstr" (text $ show instr) where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -300,9 +283,9 @@ aarch64_patchRegsOfInstr instr env = case instr of -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -aarch64_isJumpishInstr :: Instr -> Bool -aarch64_isJumpishInstr instr = case instr of - ANN _ i -> aarch64_isJumpishInstr i +isJumpishInstr :: Instr -> Bool +isJumpishInstr instr = case instr of + ANN _ i -> isJumpishInstr i CBZ{} -> True CBNZ{} -> True J{} -> True @@ -314,23 +297,23 @@ aarch64_isJumpishInstr instr = case instr of -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -aarch64_jumpDestsOfInstr :: Instr -> [BlockId] -aarch64_jumpDestsOfInstr (ANN _ i) = aarch64_jumpDestsOfInstr i -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 (BCOND _ t) = [ id | TBlock id <- [t]] -aarch64_jumpDestsOfInstr _ = [] +jumpDestsOfInstr :: Instr -> [BlockId] +jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i +jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr _ = [] -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join -- points. -aarch64_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr -aarch64_patchJumpInstr instr patchF +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr +patchJumpInstr instr patchF = case instr of - ANN d i -> ANN d (aarch64_patchJumpInstr i patchF) + ANN d i -> ANN d (patchJumpInstr i patchF) CBZ r (TBlock bid) -> CBZ r (TBlock (patchF bid)) CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid)) J (TBlock bid) -> J (TBlock (patchF bid)) @@ -356,7 +339,7 @@ aarch64_patchJumpInstr instr patchF -- 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 +mkSpillInstr :: HasCallStack => NCGConfig -> Reg -- register to spill @@ -364,14 +347,14 @@ aarch64_mkSpillInstr -> Int -- spill slot to use -> [Instr] -aarch64_mkSpillInstr config reg delta slot = +mkSpillInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of 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) + imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -384,21 +367,21 @@ aarch64_mkSpillInstr config reg delta slot = off = spillSlotToOffset config slot -aarch64_mkLoadInstr +mkLoadInstr :: NCGConfig -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> [Instr] -aarch64_mkLoadInstr config reg delta slot = +mkLoadInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of 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) + imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -414,16 +397,16 @@ aarch64_mkLoadInstr config reg delta slot = -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta -aarch64_takeDeltaInstr :: Instr -> Maybe Int -aarch64_takeDeltaInstr (ANN _ i) = aarch64_takeDeltaInstr i -aarch64_takeDeltaInstr (DELTA i) = Just i -aarch64_takeDeltaInstr _ = Nothing +takeDeltaInstr :: Instr -> Maybe Int +takeDeltaInstr (ANN _ i) = takeDeltaInstr i +takeDeltaInstr (DELTA i) = Just i +takeDeltaInstr _ = Nothing -- Not real instructions. Just meta data -aarch64_isMetaInstr :: Instr -> Bool -aarch64_isMetaInstr instr +isMetaInstr :: Instr -> Bool +isMetaInstr instr = case instr of - ANN _ i -> aarch64_isMetaInstr i + ANN _ i -> isMetaInstr i COMMENT{} -> True MULTILINE_COMMENT{} -> True LOCATION{} -> True @@ -436,32 +419,32 @@ 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 = ANN (text $ "Reg->Reg Move: " ++ show src ++ " -> " ++ show dst) $ MOV (OpReg W64 dst) (OpReg W64 src) +mkRegRegMoveInstr :: Reg -> Reg -> Instr +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) ---aarch64_takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst) -aarch64_takeRegRegMoveInstr _ = Nothing +takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) +--takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst) +takeRegRegMoveInstr _ = Nothing -- | Make an unconditional jump instruction. -aarch64_mkJumpInstr :: BlockId -> [Instr] -aarch64_mkJumpInstr id = [B (TBlock id)] +mkJumpInstr :: BlockId -> [Instr] +mkJumpInstr id = [B (TBlock id)] -aarch64_mkStackAllocInstr :: Platform -> Int -> [Instr] -aarch64_mkStackAllocInstr platform n +mkStackAllocInstr :: Platform -> Int -> [Instr] +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) + | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : mkStackAllocInstr platform (n - 4095) +mkStackAllocInstr _platform n = pprPanic "mkStackAllocInstr" (int n) -aarch64_mkStackDeallocInstr :: Platform -> Int -> [Instr] -aarch64_mkStackDeallocInstr platform n +mkStackDeallocInstr :: Platform -> Int -> [Instr] +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) + | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : mkStackDeallocInstr platform (n - 4095) +mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n) -- -- See note [extra spill slots] in X86/Instr.hs @@ -502,8 +485,8 @@ 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 | jumpDestsOfInstr insn /= [] + -> patchJumpInstr insn retarget : r _other -> insn : r where retarget b = fromMaybe b (mapLookup b new_blockmap) ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -1,4 +1,6 @@ -module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl) where +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where import GHC.Prelude hiding (EQ) @@ -11,7 +13,6 @@ import GHC.CmmToAsm.AArch64.Instr import GHC.CmmToAsm.AArch64.Regs import GHC.CmmToAsm.AArch64.Cond import GHC.CmmToAsm.Ppr -import GHC.CmmToAsm.Instr hiding (pprInstr) import GHC.CmmToAsm.Format import GHC.Platform.Reg import GHC.CmmToAsm.Config ===================================== compiler/GHC/CmmToAsm/Instr.hs ===================================== @@ -16,8 +16,6 @@ import GHC.Cmm.BlockId import GHC.CmmToAsm.Config -import GHC.Utils.Outputable (SDoc) - import GHC.Stack -- | Holds a list of source and destination registers used by a ===================================== compiler/ghc.cabal.in ===================================== @@ -600,6 +600,7 @@ Library GHC.CmmToAsm.X86.Cond GHC.CmmToAsm.X86.Ppr GHC.CmmToAsm.X86.CodeGen + GHC.CmmToAsm.AArch64 GHC.CmmToAsm.AArch64.Regs GHC.CmmToAsm.AArch64.RegInfo GHC.CmmToAsm.AArch64.Instr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64c698d8aa6d445d4192af17c9bb78afbf1440eb...e8060bf8b930ca2e384c588c83735bf146fed6b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64c698d8aa6d445d4192af17c9bb78afbf1440eb...e8060bf8b930ca2e384c588c83735bf146fed6b6 You're receiving 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 12 10:54:37 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 12 Sep 2020 06:54:37 -0400 Subject: [Git][ghc/ghc][wip/T18645] 26 commits: DynFlags: add OptCoercionOpts Message-ID: <5f5ca8edc469f_80b3f8454928264117032c1@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 379e5c5b by Sebastian Graf at 2020-09-12T12:54:01+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 - - - - - 2167710e by Sebastian Graf at 2020-09-12T12:54:01+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. - - - - - 8f6bb34c by Sebastian Graf at 2020-09-12T12:54:01+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 - 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/Hooks.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/9280042ca55ccd66d3e419e41e62a2bd2e28bd6f...8f6bb34c3d3c8ccff3a30d7a6f9d87b66e0801fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9280042ca55ccd66d3e419e41e62a2bd2e28bd6f...8f6bb34c3d3c8ccff3a30d7a6f9d87b66e0801fb You're receiving 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 12 12:36:00 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Sat, 12 Sep 2020 08:36:00 -0400 Subject: [Git][ghc/ghc][wip/T18645] 3 commits: Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f5cc0b093f4e_80b3f8459e93a5011709772@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 229e4f1e by Sebastian Graf at 2020-09-12T14:35:41+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 T18478 - - - - - 3ff5158b by Sebastian Graf at 2020-09-12T14:35:48+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. - - - - - 422154a2 by Sebastian Graf at 2020-09-12T14:35:48+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. - - - - - 16 changed files: - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/ghc.cabal.in - + 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/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,7 +37,6 @@ 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.Data.Bag import GHC.Types.Name.Reader @@ -58,6 +58,7 @@ import GHC.Hs.Extension import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe +import qualified Data.Kind {- ************************************************************************ @@ -89,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/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/PmCheck/Oracle.hs ===================================== @@ -584,13 +584,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) @@ -597,15 +596,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/HsToCore/Types.hs ===================================== @@ -0,0 +1,85 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + +-- | 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 (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) + +{- +************************************************************************ +* * + 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 + +-- See Note [The Decoupling Abstract Data Hack] +type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) ===================================== 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/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 ===================================== 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 ===================================== @@ -314,6 +314,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call ===================================== 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/-/compare/8f6bb34c3d3c8ccff3a30d7a6f9d87b66e0801fb...422154a23ef3151721d86688b9aa8f06c0a05b18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f6bb34c3d3c8ccff3a30d7a6f9d87b66e0801fb...422154a23ef3151721d86688b9aa8f06c0a05b18 You're receiving 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 12 13:06:13 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Sat, 12 Sep 2020 09:06:13 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] Open an orphanage Message-ID: <5f5cc7c514bc9_80b3f845886b098117158a5@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 0d14c2d5 by Moritz Angermann at 2020-09-12T13:06:02+00:00 Open an orphanage eventually. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -1,4 +1,5 @@ {-# language CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module GHC.CmmToAsm.AArch64.Regs where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d14c2d513f4ce5fd34c04192511406a007139d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d14c2d513f4ce5fd34c04192511406a007139d6 You're receiving 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 12 13:07:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 12 Sep 2020 09:07:24 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump version to 9.0 Message-ID: <5f5cc80cb521b_80b10cb1c30117167ae@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 5266a738 by Ben Gamari at 2020-09-12T09:07:11-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (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/5266a73814b52a977dc5cc10281b860556061df0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5266a73814b52a977dc5cc10281b860556061df0 You're receiving 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 12 16:26:22 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 12 Sep 2020 12:26:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18653 Message-ID: <5f5cf6ae65c1a_80b10e71980117313f8@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/T18653 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18653 You're receiving 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 12 18:37:02 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 14:37:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Add clamp function to Data.Ord Message-ID: <5f5d154edd79d_80b3f83deebcda4117542ad@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - b3186e32 by theobat at 2020-09-12T14:36:55-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - aacd1496 by Sebastian Graf at 2020-09-12T14:36:55-04: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 T18478 - - - - - 848e02ac by Sebastian Graf at 2020-09-12T14:36:55-04: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. - - - - - 04270c3e by Sebastian Graf at 2020-09-12T14:36:55-04: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: - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - + compiler/GHC/HsToCore/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/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Unique/FM.hs - compiler/ghc.cabal.in - docs/users_guide/exts/pragmas.rst - hadrian/src/Builder.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/Data/Ord.hs - libraries/base/tests/all.T - + libraries/base/tests/clamp.hs - + libraries/base/tests/clamp.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96800cfff5e31a3460820ba39fb136556893581f...04270c3e75a1c586e2b301acca05775d138b9b7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/96800cfff5e31a3460820ba39fb136556893581f...04270c3e75a1c586e2b301acca05775d138b9b7c You're receiving 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 12 20:00:24 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Sat, 12 Sep 2020 16:00:24 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] 3 commits: Minor fixes from code review Message-ID: <5f5d28d8507d2_80b3f8487fb075c117628ed@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: b139f25f by Adam Gundry at 2020-09-12T15:55:17+01:00 Minor fixes from code review - - - - - 5fef615b by Adam Gundry at 2020-09-12T16:01:54+01:00 Rename {FieldLabel,FieldLabelWithUpdate} -> {FieldLabelNoUpdater,FieldLabel} - - - - - fdff0fe1 by Adam Gundry at 2020-09-12T20:58:30+01:00 Update comments in response to review - - - - - 28 changed files: - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Avail.hs - compiler/GHC/Types/FieldLabel.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Name/Shape.hs Changes: ===================================== compiler/GHC/Core/ConLike.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Prelude import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Utils.Outputable +import GHC.Types.FieldLabel import GHC.Types.Unique import GHC.Utils.Misc import GHC.Types.Name @@ -103,9 +104,11 @@ conLikeArity (RealDataCon data_con) = dataConSourceArity data_con conLikeArity (PatSynCon pat_syn) = patSynArity pat_syn -- | Names of fields used for selectors -conLikeFieldLabels :: ConLike -> [FieldLabel] -conLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con -conLikeFieldLabels (PatSynCon pat_syn) = patSynFieldLabels pat_syn +conLikeFieldLabels :: ConLike -> [FieldLabelNoUpdater] +conLikeFieldLabels (RealDataCon data_con) = + fieldLabelsWithoutUpdaters (dataConFieldLabels data_con) +conLikeFieldLabels (PatSynCon pat_syn) = + patSynFieldLabels pat_syn -- | Returns just the instantiated /value/ argument types of a 'ConLike', -- (excluding dictionary args) ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -40,8 +40,7 @@ module GHC.Core.DataCon ( dataConOtherTheta, dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy, dataConInstOrigArgTys, dataConRepArgTys, - dataConFieldLabels, dataConFieldLabelsWithUpdates, - dataConFieldType, dataConFieldType_maybe, + dataConFieldLabels, dataConFieldType, dataConFieldType_maybe, dataConSrcBangs, dataConSourceArity, dataConRepArity, dataConIsInfix, @@ -436,7 +435,7 @@ data DataCon -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon - dcFields :: [FieldLabelWithUpdate], + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; -- length = 0 (if not a record) or dataConSourceArity. @@ -942,8 +941,8 @@ mkDataCon :: Name -> Bool -- ^ Is the constructor declared infix? -> TyConRepName -- ^ TyConRepName for the promoted TyCon -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabelWithUpdate] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty -> [TyVar] -- ^ Universals. -> [TyCoVar] -- ^ Existentials. -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. @@ -1200,12 +1199,7 @@ dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep }) -- | The labels for the fields of this particular 'DataCon' dataConFieldLabels :: DataCon -> [FieldLabel] -dataConFieldLabels = fieldLabelsWithoutUpdates . dcFields - --- | The labels for the fields of this particular 'DataCon', --- including the updater functions for each -dataConFieldLabelsWithUpdates :: DataCon -> [FieldLabelWithUpdate] -dataConFieldLabelsWithUpdates = dcFields +dataConFieldLabels = dcFields -- | Extract the type for any given labelled field of the 'DataCon' dataConFieldType :: DataCon -> FieldLabelString -> Type @@ -1218,7 +1212,7 @@ dataConFieldType con label = case dataConFieldType_maybe con label of dataConFieldType_maybe :: DataCon -> FieldLabelString -> Maybe (FieldLabel, Type) dataConFieldType_maybe con label - = find ((== label) . flLabel . fst) (dataConFieldLabels con `zip` (scaledThing <$> dcOrigArgTys con)) + = find ((== label) . flLabel . fst) (dcFields con `zip` (scaledThing <$> dcOrigArgTys con)) -- | Strictness/unpack annotations, from user; or, for imported -- DataCons, from the interface file ===================================== compiler/GHC/Core/DataCon.hs-boot ===================================== @@ -4,7 +4,7 @@ import GHC.Prelude import GHC.Types.Var( TyVar, TyCoVar, InvisTVBinder ) import GHC.Types.Name( Name, NamedThing ) import {-# SOURCE #-} GHC.Core.TyCon( TyCon ) -import GHC.Types.FieldLabel ( FieldLabel, FieldLabelWithUpdate ) +import GHC.Types.FieldLabel ( FieldLabel ) import GHC.Types.Unique ( Uniquable ) import GHC.Utils.Outputable ( Outputable, OutputableBndr ) import GHC.Types.Basic (Arity) @@ -21,7 +21,6 @@ dataConUserTyVars :: DataCon -> [TyVar] dataConUserTyVarBinders :: DataCon -> [InvisTVBinder] dataConSourceArity :: DataCon -> Arity dataConFieldLabels :: DataCon -> [FieldLabel] -dataConFieldLabelsWithUpdates :: DataCon -> [FieldLabelWithUpdate] dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] dataConStupidTheta :: DataCon -> ThetaType dataConFullSig :: DataCon ===================================== compiler/GHC/Core/PatSyn.hs ===================================== @@ -63,11 +63,10 @@ data PatSyn psArgs :: [Type], psArity :: Arity, -- == length psArgs psInfix :: Bool, -- True <=> declared infix - psFieldLabels :: [FieldLabel], -- List of fields for a - -- record pattern synonym - -- INVARIANT: either empty if no - -- record pat syn or same length as - -- psArgs + + -- List of fields for a record pattern synonym + -- INVARIANT: either empty if no record pat syn or same length as psArgs + psFieldLabels :: [FieldLabelNoUpdater], -- Universally-quantified type variables psUnivTyVars :: [InvisTVBinder], @@ -365,8 +364,8 @@ mkPatSyn :: Name -> Type -- ^ Original result type -> (Id, Bool) -- ^ Name of matcher -> Maybe (Id, Bool) -- ^ Name of builder - -> [FieldLabel] -- ^ Names of fields for - -- a record pattern synonym + -> [FieldLabelNoUpdater] -- ^ Names of fields for + -- a record pattern synonym -> PatSyn -- NB: The univ and ex vars are both in TyBinder form and TyVar form for -- convenience. All the TyBinders should be Named! @@ -404,7 +403,7 @@ patSynArity = psArity patSynArgs :: PatSyn -> [Type] patSynArgs = psArgs -patSynFieldLabels :: PatSyn -> [FieldLabel] +patSynFieldLabels :: PatSyn -> [FieldLabelNoUpdater] patSynFieldLabels = psFieldLabels -- | Extract the type for any given labelled field of the 'DataCon' ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -27,7 +27,6 @@ module GHC.Core.TyCon( -- ** Field labels tyConFieldLabels, lookupTyConFieldLabel, - tyConFieldLabelsWithUpdates, -- ** Constructing TyCons mkAlgTyCon, @@ -147,7 +146,7 @@ import {-# SOURCE #-} GHC.Builtin.Types , multiplicityTyCon , vecCountTyCon, vecElemTyCon, liftedTypeKind ) import {-# SOURCE #-} GHC.Core.DataCon - ( DataCon, dataConExTyCoVars, dataConFieldLabelsWithUpdates + ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig , isUnboxedSumCon ) @@ -1548,11 +1547,7 @@ primRepIsFloat _ = Just False -- | The labels for the fields of this particular 'TyCon' tyConFieldLabels :: TyCon -> [FieldLabel] -tyConFieldLabels tc = fieldLabelsWithoutUpdates $ tyConFieldLabelsWithUpdates tc - -tyConFieldLabelsWithUpdates :: TyCon -> [FieldLabelWithUpdate] -tyConFieldLabelsWithUpdates tc = dFsEnvElts $ tyConFieldLabelEnv tc - +tyConFieldLabels tc = dFsEnvElts $ tyConFieldLabelEnv tc -- | The labels for the fields of this particular 'TyCon' tyConFieldLabelEnv :: TyCon -> FieldLabelEnv @@ -1561,7 +1556,7 @@ tyConFieldLabelEnv tc | otherwise = emptyDFsEnv -- | Look up a field label belonging to this 'TyCon' -lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabelWithUpdate +lookupTyConFieldLabel :: FieldLabelString -> TyCon -> Maybe FieldLabel lookupTyConFieldLabel lbl tc = lookupDFsEnv (tyConFieldLabelEnv tc) lbl -- | Make a map from strings to FieldLabels from all the data @@ -1571,7 +1566,7 @@ fieldsOfAlgTcRhs rhs = mkDFsEnv [ (flLabel fl, fl) | fl <- dataConsFields (visibleDataCons rhs) ] where -- Duplicates in this list will be removed by 'mkFsEnv' - dataConsFields dcs = concatMap dataConFieldLabelsWithUpdates dcs + dataConsFields dcs = concatMap dataConFieldLabels dcs {- ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -178,6 +178,7 @@ import GHC.Unit import GHC.Core.InstEnv ( InstEnv, ClsInst, identicalClsInstHead ) import GHC.Core.FamInstEnv import GHC.Core ( CoreProgram, RuleBase, CoreRule ) +import GHC.Types.FieldLabel import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Var.Set @@ -2208,7 +2209,7 @@ tyThingAvailInfo (ATyCon t) Nothing -> [AvailTC n (n : map getName dcs) flds] where n = getName t dcs = tyConDataCons t - flds = tyConFieldLabels t + flds = fieldLabelsWithoutUpdaters (tyConFieldLabels t) tyThingAvailInfo (AConLike (PatSynCon p)) = map avail ((getName p) : map flSelector (patSynFieldLabels p)) tyThingAvailInfo t ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -228,14 +228,16 @@ data IE pass -- See Note [Located RdrNames] in GHC.Hs.Expr | IEThingWith (XIEThingWith pass) - (LIEWrappedName (IdP pass)) + (LIEWrappedName (IdP pass)) -- Parent IEWildcard - [LIEWrappedName (IdP pass)] - [XRec pass (FieldLbl () (IdP pass))] - -- ^ Imported or exported Thing With given imported or exported + [LIEWrappedName (IdP pass)] -- Child methods/constructors, and + -- record fields (only in parser) + [XRec pass (FieldLbl () (IdP pass))] -- Child record fields (after renaming) + -- ^ Imported or exported Thing With given imported or exported children -- - -- The thing is a Class/Type and the imported or exported things are + -- The thing is a Class/Type and the imported or exported children are -- methods/constructors and record fields; see Note [IEThingWith] + -- -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen', -- 'GHC.Parser.Annotation.AnnClose', -- 'GHC.Parser.Annotation.AnnComma', @@ -271,18 +273,45 @@ data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data) {- Note [IEThingWith] ~~~~~~~~~~~~~~~~~~ +IEThingWith represents a parent type constructor or class together with its +children imported or exported along with it. There are two lists of children: + + * [LIEWrappedName (IdP pass)] - always contains data constructors or class + methods, and prior to renaming contains record fields; + + * [XRec pass (FieldLbl () (IdP pass))] - empty prior to renaming, then after + renaming contains record fields identified by their selectors. + +We need to store a FieldLbl, because we need the flLabel for pretty-printing the +right field (we don't want to show the internal selector name), and we need the +flSelector to uniquely identify the field in the renamer. We do not need the +updater name (see Note [Updater names] in GHC.Types.FieldLabel). -A definition like +For example, a definition like module M ( T(MkT, x) ) where data T = MkT { x :: Int } -gives rise to +gives rise to (in the parser): + + IEThingWith noExtField T NoIEWildcard [MkT,x] [] + +but the renamer moves record fields from the general list of children to the +list of field labels, giving one of these instead: + + (without DuplicateRecordFields): + IEThingWith noExtField T NoIEWildcard [MkT] [FieldLabel "x" False () x] + + (with DuplicateRecordFields): + IEThingWith noExtField T NoIEWildcard [MkT] [FieldLabel "x" True () $sel:x:MkT] - IEThingWith T [MkT] [FieldLabel "x" False x)] (without DuplicateRecordFields) - IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)] (with DuplicateRecordFields) +See Note [Representing fields in AvailInfo] in GHC.Types.Avail for more details +about how different FieldLabels are produced depending on the state of the +DuplicateRecordFields extension. -See Note [Representing fields in AvailInfo] in GHC.Types.Avail for more details. +It might be better to move the list of field labels to the extension point, so +that it is absent in GhcPs but present from GhcRn onwards. At the moment we +simply maintain the invariant that the parser always produces an empty list. -} ieName :: IE (GhcPass p) -> IdP (GhcPass p) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -2027,6 +2027,6 @@ instance ToHie (IEContext (LIEWrappedName Name)) where instance ToHie (IEContext (Located (FieldLbl () Name))) where toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of - FieldLabel _ _ _ n -> + FieldLabel { flSelector = n } -> [ toHie $ C (IEThing c) $ L span n ] ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -554,7 +554,7 @@ tyConToIfaceDecl env tycon ifConArgTys = map (\(Scaled w t) -> (tidyToIfaceType con_env2 w , (tidyToIfaceType con_env2 t))) arg_tys, - ifConFields = dataConFieldLabelsWithUpdates data_con, + ifConFields = dataConFieldLabels data_con, ifConStricts = map (toIfaceBang con_env2) (dataConImplBangs data_con), ifConSrcStricts = map toIfaceSrcBang ===================================== compiler/GHC/Iface/Rename.hs ===================================== @@ -245,25 +245,25 @@ rnAvailInfo (AvailTC n ns fs) = do -- is. But for the availNames they MUST be exported, so they -- will rename fine. ns' <- mapM rnIfaceGlobal ns - fs' <- mapM rnFieldLabel fs + fs' <- mapM rnFieldLabelNoUpdater fs case ns' ++ map flSelector fs' of [] -> panic "rnAvailInfoEmpty AvailInfo" (rep:rest) -> ASSERT2( all ((== nameModule rep) . nameModule) rest, ppr rep $$ hcat (map ppr rest) ) do n' <- setNameModule (Just (nameModule rep)) n return (AvailTC n' ns' fs') -rnFieldLabel :: Rename FieldLabel -rnFieldLabel (FieldLabel l b () sel) = do +rnFieldLabelNoUpdater :: Rename FieldLabelNoUpdater +rnFieldLabelNoUpdater fl@(FieldLabel { flSelector = sel }) = do sel' <- rnIfaceGlobal sel - return (FieldLabel l b () sel') + return (fl { flSelector = sel' }) -rnFieldLabelWithUpdate :: Rename FieldLabelWithUpdate -rnFieldLabelWithUpdate (FieldLabel l b upd sel) = do +rnFieldLabel :: Rename FieldLabel +rnFieldLabel fl@(FieldLabel { flUpdate = upd, flSelector = sel }) = do -- The selector appears in the AvailInfo, so it gets renamed normally, but -- the updater does not so it is a "never-exported TyThing". upd' <- rnIfaceNeverExported upd sel' <- rnIfaceGlobal sel - return (FieldLabel l b upd' sel') + return (fl { flUpdate = upd', flSelector = sel' }) @@ -574,7 +574,7 @@ rnIfaceConDecl d = do con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d) con_ctxt <- mapM rnIfaceType (ifConCtxt d) con_arg_tys <- mapM rnIfaceScaledType (ifConArgTys d) - con_fields <- mapM rnFieldLabelWithUpdate (ifConFields d) + con_fields <- mapM rnFieldLabel (ifConFields d) let rnIfaceBang (IfUnpackCo co) = IfUnpackCo <$> rnIfaceCo co rnIfaceBang bang = pure bang con_stricts <- mapM rnIfaceBang (ifConStricts d) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -173,7 +173,7 @@ data IfaceDecl ifPatReqCtxt :: IfaceContext, ifPatArgs :: [IfaceType], ifPatTy :: IfaceType, - ifFieldLabels :: [FieldLabel] } + ifFieldLabels :: [FieldLabelNoUpdater] } -- See also 'ClassBody' data IfaceClassBody @@ -262,7 +262,9 @@ data IfaceConDecl ifConEqSpec :: IfaceEqSpec, -- Equality constraints ifConCtxt :: IfaceContext, -- Non-stupid context ifConArgTys :: [(IfaceMult, IfaceType)],-- Arg types - ifConFields :: [FieldLabelWithUpdate], -- ...ditto... (field labels) + ifConFields :: [FieldLabel], -- Field labels: we carefully serialise + -- the Names of the selector and updater, + -- so there is no doubt when deserialising ifConStricts :: [IfaceBang], -- Empty (meaning all lazy), -- or 1-1 corresp with arg tys @@ -1237,7 +1239,7 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent pp_field_args = braces $ sep $ punctuate comma $ ppr_trim $ zipWith maybe_show_label fields tys_w_strs - maybe_show_label :: FieldLabelWithUpdate -> (IfaceBang, IfaceType) -> Maybe SDoc + maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc maybe_show_label lbl bty | showSub ss sel = Just (pprPrefixIfDeclBndr how_much occ <+> dcolon <+> pprFieldArgTy bty) ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Rename.Env ( lookupSigCtxtOccRn, lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName, - lookupConstructorFields, lookupDataConFieldsWithUpdates, + lookupConstructorFields, lookupDataConFields, lookupGreAvailRn, @@ -386,8 +386,8 @@ lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrenc = lookupLocatedOccRn tc_rdr ----------------------------------------------- -lookupConstructorFields :: Name -> RnM [FieldLabel] --- Look up the fields of a given constructor +lookupConstructorFields :: Name -> RnM [FieldLabelNoUpdater] +-- Look up the fields of a given data constructor or pattern synonym -- * For constructors from this module, use the record field env, -- which is itself gathered from the (as yet un-typechecked) -- data type decls @@ -395,13 +395,15 @@ lookupConstructorFields :: Name -> RnM [FieldLabel] -- * For constructors from imported modules, use the *type* environment -- since imported modules are already compiled, the info is conveniently -- right there +-- +-- Returns field labels without updaters (pattern synonyms don't have them). lookupConstructorFields con_name = do { this_mod <- getModule ; if nameIsLocalOrFrom this_mod con_name then do { field_env <- getRecFieldEnv ; traceTc "lookupCF" (ppr con_name $$ ppr (lookupNameEnv field_env con_name) $$ ppr field_env) - ; return (fieldLabelsWithoutUpdates + ; return (fieldLabelsWithoutUpdaters (lookupNameEnv field_env con_name `orElse` [])) } else do { con <- tcLookupConLike con_name @@ -410,8 +412,8 @@ lookupConstructorFields con_name -- | Look up the fields of a given *data* constructor, like -- 'lookupConstructorFields', but include the names of the update functions. -lookupDataConFieldsWithUpdates :: Name -> RnM [FieldLabelWithUpdate] -lookupDataConFieldsWithUpdates con_name +lookupDataConFields :: Name -> RnM [FieldLabel] +lookupDataConFields con_name = do { this_mod <- getModule ; if nameIsLocalOrFrom this_mod con_name then do { field_env <- getRecFieldEnv @@ -420,7 +422,7 @@ lookupDataConFieldsWithUpdates con_name else do { con <- tcLookupDataCon con_name ; traceTc "lookupCF 2" (ppr con) - ; return (dataConFieldLabelsWithUpdates con) } } + ; return (dataConFieldLabels con) } } -- In CPS style as `RnM r` is monadic @@ -644,13 +646,17 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name FoundFL (fldParentToFieldLabel gre_name mfs) _ -> FoundName gre_par gre_name - fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabel + fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabelNoUpdater fldParentToFieldLabel name mfs = - case mfs of - Nothing -> - let fs = occNameFS (nameOccName name) - in FieldLabel fs False () name - Just fs -> FieldLabel fs True () name + FieldLabel { flLabel = fs + , flIsOverloaded = is_overloaded + , flUpdate = () + , flSelector = name + } + where + (fs, is_overloaded) = case mfs of + Nothing -> (occNameFS (nameOccName name), False) + Just fs -> (fs, True) -- Called when we find no matching GREs after disambiguation but -- there are three situations where this happens. @@ -760,7 +766,7 @@ data ChildLookupResult SDoc -- How to print the name [Name] -- List of possible parents | FoundName Parent Name -- We resolved to a normal name - | FoundFL FieldLabel -- We resolved to a FL + | FoundFL FieldLabelNoUpdater -- We resolved to a field -- | Specialised version of msum for RnM ChildLookupResult combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1136,7 +1136,9 @@ GHC.Rename.Names.getLocalNonValBinders), so we just take the list as an argument, build a map and look them up. -} -rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs] +rnConDeclFields :: HsDocContext + -> [FieldLabelNoUpdater] + -> [LConDeclField GhcPs] -> RnM ([LConDeclField GhcRn], FreeVars) -- Also called from GHC.Rename.Module -- No wildcards can appear in record fields @@ -1146,7 +1148,9 @@ rnConDeclFields ctxt fls fields env = mkTyKiEnv ctxt TypeLevel RnTypeBody fl_env = mkFsEnv [ (flLabel fl, fl) | fl <- fls ] -rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs +rnField :: FastStringEnv FieldLabelNoUpdater + -> RnTyKiEnv + -> LConDeclField GhcPs -> RnM (LConDeclField GhcRn, FreeVars) rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) = do { let new_names = map (fmap lookupField) names ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -2308,13 +2308,13 @@ extendPatSynEnv val_decls local_fix_env thing = do { final_gbl_env = gbl_env { tcg_field_env = field_env' } ; setEnvs (final_gbl_env, lcl_env) (thing pat_syn_bndrs) } where - new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabelWithUpdate])] + new_ps :: HsValBinds GhcPs -> TcM [(Name, [FieldLabel])] new_ps (ValBinds _ binds _) = foldrM new_ps' [] binds new_ps _ = panic "new_ps" new_ps' :: LHsBindLR GhcPs GhcPs - -> [(Name, [FieldLabelWithUpdate])] - -> TcM [(Name, [FieldLabelWithUpdate])] + -> [(Name, [FieldLabel])] + -> TcM [(Name, [FieldLabel])] new_ps' bind names | (L bind_loc (PatSynBind _ (PSB { psb_id = L _ n , psb_args = RecCon as }))) <- bind ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -736,7 +736,7 @@ getLocalNonValBinders fixity_env ; return (avail nm) } new_tc :: Bool -> LTyClDecl GhcPs - -> RnM (AvailInfo, [(Name, [FieldLabelWithUpdate])]) + -> RnM (AvailInfo, [(Name, [FieldLabel])]) new_tc overload_ok tc_decl -- NOT for type/data instances = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs @@ -744,14 +744,14 @@ getLocalNonValBinders fixity_env ; let fld_env = case unLoc tc_decl of DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds' _ -> [] - ; return (AvailTC main_name names (fieldLabelsWithoutUpdates flds'), fld_env) } + ; return (AvailTC main_name names (fieldLabelsWithoutUpdaters flds'), fld_env) } -- Calculate the mapping from constructor names to fields, which -- will go in tcg_field_env. It's convenient to do this here where -- we are working with a single datatype definition. - mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabelWithUpdate] - -> [(Name, [FieldLabelWithUpdate])] + mk_fld_env :: HsDataDefn GhcPs -> [Name] -> [FieldLabel] + -> [(Name, [FieldLabel])] mk_fld_env d names flds = concatMap find_con_flds (dd_cons d) where find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr @@ -778,7 +778,7 @@ getLocalNonValBinders fixity_env where lbl = occNameFS (rdrNameOcc rdr) new_assoc :: Bool -> LInstDecl GhcPs - -> RnM ([AvailInfo], [(Name, [FieldLabelWithUpdate])]) + -> RnM ([AvailInfo], [(Name, [FieldLabel])]) new_assoc _ (L _ (TyFamInstD {})) = return ([], []) -- type instances don't bind new names @@ -813,7 +813,7 @@ getLocalNonValBinders fixity_env pure (avails, concat fldss) new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs - -> RnM (AvailInfo, [(Name, [FieldLabelWithUpdate])]) + -> RnM (AvailInfo, [(Name, [FieldLabel])]) new_di overload_ok mb_cls dfid@(DataFamInstDecl { dfid_eqn = HsIB { hsib_body = ti_decl }}) = do { main_name <- lookupFamInstName mb_cls (feqn_tycon ti_decl) @@ -822,16 +822,16 @@ getLocalNonValBinders fixity_env ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds ; let avail = AvailTC (unLoc main_name) sub_names - (fieldLabelsWithoutUpdates flds') + (fieldLabelsWithoutUpdaters flds') -- main_name is not bound here! fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds' ; return (avail, fld_env) } new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs - -> RnM (AvailInfo, [(Name, [FieldLabelWithUpdate])]) + -> RnM (AvailInfo, [(Name, [FieldLabel])]) new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d -newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabelWithUpdate +newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!" newRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld))) = do { selName <- newTopSrcBinder $ L loc $ field @@ -1063,6 +1063,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) , []) IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns rdr_fs -> + -- See Note [IEThingWith] in GHC.Hs.ImpExp for why rdr_fs is null ASSERT2(null rdr_fs, ppr rdr_fs) do (name, avail, mb_parent) <- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc) @@ -1197,9 +1198,11 @@ mkChildEnv gres = foldr add emptyNameEnv gres findChildren :: NameEnv [a] -> Name -> [a] findChildren env n = lookupNameEnv env n `orElse` [] -lookupChildren :: [Either Name FieldLabel] -> [LIEWrappedName RdrName] +lookupChildren :: forall a b . + [Either Name (FieldLbl a b)] + -> [LIEWrappedName RdrName] -> MaybeErr [LIEWrappedName RdrName] -- The ones for which the lookup failed - ([Located Name], [Located FieldLabel]) + ([Located Name], [Located (FieldLbl a b)]) -- (lookupChildren all_kids rdr_items) maps each rdr_item to its -- corresponding Name all_kids, if the former exists -- The matching is done by FastString, not OccName, so that @@ -1211,14 +1214,14 @@ lookupChildren all_kids rdr_items | null fails = Succeeded (fmap concat (partitionEithers oks)) -- This 'fmap concat' trickily applies concat to the /second/ component - -- of the pair, whose type is ([Located Name], [[Located FieldLabel]]) + -- of the pair, whose type is ([Located Name], [[Located (FieldLbl a b)]]) | otherwise = Failed fails where mb_xs = map doOne rdr_items fails = [ bad_rdr | Failed bad_rdr <- mb_xs ] oks = [ ok | Succeeded ok <- mb_xs ] - oks :: [Either (Located Name) [Located FieldLabel]] + oks :: [Either (Located Name) [Located (FieldLbl a b)]] doOne item@(L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc . ieWrappedName) r of ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -19,6 +19,7 @@ import GHC.Rename.Names import GHC.Rename.Env import GHC.Rename.Unbound ( reportUnboundName ) import GHC.Utils.Error +import GHC.Types.FieldLabel import GHC.Types.Id import GHC.Types.Id.Info import GHC.Unit.Module @@ -32,7 +33,6 @@ import GHC.Driver.Types import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.ConLike -import GHC.Core.DataCon import GHC.Core.PatSyn import GHC.Data.Maybe import GHC.Types.Unique.Set @@ -377,7 +377,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName] -> RnM (Located Name, [LIEWrappedName Name], [Name], - [Located FieldLabel]) + [Located FieldLabelNoUpdater]) lookup_ie_with (L l rdr) sub_rdrs = do name <- lookupGlobalOccRn $ ieWrappedName rdr (non_flds, flds) <- lookupChildrenExport name sub_rdrs @@ -388,7 +388,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod , flds) lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName - -> RnM (Located Name, [Name], [FieldLabel]) + -> RnM (Located Name, [Name], [FieldLabelNoUpdater]) lookup_ie_all ie (L l rdr) = do name <- lookupGlobalOccRn $ ieWrappedName rdr let gres = findChildren kids_env name @@ -420,10 +420,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM () addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres) -classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel]) +classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabelNoUpdater]) classifyGREs = partitionEithers . map classifyGRE -classifyGRE :: GlobalRdrElt -> Either Name FieldLabel +classifyGRE :: GlobalRdrElt -> Either Name FieldLabelNoUpdater classifyGRE gre = case gre_par gre of FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False () n) FldParent _ (Just lbl) -> Right (FieldLabel lbl True () n) @@ -499,7 +499,7 @@ If the module has NO main function: lookupChildrenExport :: Name -> [LIEWrappedName RdrName] - -> RnM ([LIEWrappedName Name], [Located FieldLabel]) + -> RnM ( [LIEWrappedName Name], [Located FieldLabelNoUpdater] ) lookupChildrenExport spec_parent rdr_items = do xs <- mapAndReportM doOne rdr_items @@ -515,7 +515,7 @@ lookupChildrenExport spec_parent rdr_items = | otherwise = [ns] -- Process an individual child doOne :: LIEWrappedName RdrName - -> RnM (Either (LIEWrappedName Name) (Located FieldLabel)) + -> RnM (Either (LIEWrappedName Name) (Located FieldLabelNoUpdater)) doOne n = do let bareName = (ieWrappedName . unLoc) n ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Tc.Utils.Zonk import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Instantiate +import GHC.Types.FieldLabel import GHC.Types.Id import GHC.Types.Var import GHC.Types.Name @@ -1170,7 +1171,7 @@ tcConArgs con_like arg_tys penv con_args thing_inside = case con_args of traceTc "find_field" (ppr pat_ty <+> ppr extras) ASSERT( null extras ) (return pat_ty) - field_tys :: [(FieldLabel, Scaled TcType)] + field_tys :: [(FieldLabelNoUpdater, Scaled TcType)] field_tys = zip (conLikeFieldLabels con_like) arg_tys -- Don't use zipEqual! If the constructor isn't really a record, then -- dataConFieldLabels will be empty (and each field in the pattern ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -676,7 +676,7 @@ matchHasField dflags short_cut clas tys -- x should be a field of r , Just fl <- lookupTyConFieldLabel x r_tc -- the field selector should be in scope - , Just gre <- lookupGRE_FieldLabel rdr_env (fieldLabelWithoutUpdate fl) + , Just gre <- lookupGRE_FieldLabel rdr_env fl -> do { upd_id <- tcLookupId (flUpdate fl) ; (tv_prs, preds, upd_ty) <- tcInstType newMetaTyVars upd_id @@ -704,7 +704,7 @@ matchHasField dflags short_cut clas tys -- Do not generate an instance if the updater cannot be -- defined for the field and hence is (). (See Note - -- [Missing record updaters] in GHC.Tc.TyCl.Utils.) + -- [Naughty record updaters] in GHC.Tc.TyCl.Utils.) ; if not (upd_ty `eqType` unitTy) then do { addUsedGRE True gre ; return OneInst { cir_new_theta = theta ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2042,7 +2042,7 @@ runTcInteractive hsc_env thing_inside -- Putting the dfuns in the type_env -- is just to keep Core Lint happy - con_fields = [ (dataConName c, dataConFieldLabelsWithUpdates c) + con_fields = [ (dataConName c, dataConFieldLabels c) | ATyCon t <- top_ty_things , c <- tyConDataCons t ] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -45,7 +45,7 @@ import GHC.Tc.Utils.TcMType import GHC.Builtin.Types ( unitTy, makeRecoveryTyCon ) import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity -import GHC.Rename.Env( lookupDataConFieldsWithUpdates ) +import GHC.Rename.Env( lookupDataConFields ) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv import GHC.Core.Coercion @@ -3201,7 +3201,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_kind res_tmpl new_or_data do { ctxt <- tcHsMbContext hs_ctxt ; let exp_kind = getArgExpKind new_or_data res_kind ; btys <- tcConArgs exp_kind hs_args - ; field_lbls <- lookupDataConFieldsWithUpdates (unLoc name) + ; field_lbls <- lookupDataConFields (unLoc name) ; let (arg_tys, stricts) = unzip btys ; return (ctxt, arg_tys, field_lbls, stricts) } @@ -3289,7 +3289,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; btys <- tcConArgs exp_kind hs_args ; let (arg_tys, stricts) = unzip btys - ; field_lbls <- lookupDataConFieldsWithUpdates name + ; field_lbls <- lookupDataConFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) } ; imp_tvs <- zonkAndScopedSort imp_tvs ===================================== compiler/GHC/Tc/TyCl/Build.hs ===================================== @@ -105,7 +105,7 @@ buildDataCon :: FamInstEnvs -> [HsSrcBang] -> Maybe [HsImplBang] -- See Note [Bangs on imported data constructors] in GHC.Types.Id.Make - -> [FieldLabelWithUpdate] -- Field labels + -> [FieldLabel] -- Field labels -> [TyVar] -- Universals -> [TyCoVar] -- Existentials -> [InvisTVBinder] -- User-written 'TyVarBinder's @@ -176,7 +176,7 @@ buildPatSyn :: Name -> Bool -> ([InvisTVBinder], ThetaType) -- ^ Ex and prov -> [Type] -- ^ Argument types -> Type -- ^ Result type - -> [FieldLabel] -- ^ Field labels for + -> [FieldLabelNoUpdater] -- ^ Field labels for -- a record pattern synonym -> PatSyn buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder ===================================== compiler/GHC/Tc/TyCl/PatSyn.hs ===================================== @@ -763,7 +763,7 @@ tcPatSynMatcher (L loc name) lpat ; return ((matcher_id, is_unlifted), matcher_bind) } mkPatSynRecSelBinds :: PatSyn - -> [FieldLabel] -- ^ Visible field labels + -> [FieldLabelNoUpdater] -- ^ Visible field labels -> [(Id, LHsBind GhcRn)] mkPatSynRecSelBinds ps fields = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -851,11 +851,11 @@ mkRecSelBinds :: [TyCon] -> TcM [(Id, LHsBind GhcRn)] mkRecSelBinds tycons = concatMapM mkRecSelAndUpd [ (tc,fld) | tc <- tycons - , fld <- tyConFieldLabelsWithUpdates tc ] + , fld <- tyConFieldLabels tc ] -- | Create both a record selector and a record updater binding for a field in a -- TyCon. See Note [Record updaters] -mkRecSelAndUpd :: (TyCon, FieldLabelWithUpdate) -> TcM [(Id, LHsBind GhcRn)] +mkRecSelAndUpd :: (TyCon, FieldLabel) -> TcM [(Id, LHsBind GhcRn)] mkRecSelAndUpd (tycon, fl) = do -- Make fresh names x1..xN for binding all the fields in the TyCon -- (including the one being updated), and a fresh name y for binding the new @@ -871,14 +871,14 @@ mkRecSelAndUpd (tycon, fl) = do -- | Create a record selector binding, but no updater. This is used for fields -- in pattern synonyms. See Note [No updaters for pattern synonyms] -mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel +mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabelNoUpdater -> (Id, LHsBind GhcRn) mkOneRecordSelector all_cons idDetails fl = fst $ mkRecordSelectorAndUpdater all_cons idDetails (fl { flUpdate = oops }) oops oops where oops = error "mkOneRecordSelector: poked a field needed only for updaters" -mkRecordSelectorAndUpdater :: [ConLike] -> RecSelParent -> FieldLabelWithUpdate +mkRecordSelectorAndUpdater :: [ConLike] -> RecSelParent -> FieldLabel -> NameEnv Name -> Name -> ((Id, LHsBind GhcRn), (Id, LHsBind GhcRn)) mkRecordSelectorAndUpdater all_cons idDetails fl x_vars y_var = @@ -911,7 +911,7 @@ mkRecordSelectorAndUpdater all_cons idDetails fl x_vars y_var = conLikeUserTyVarBinders con1 data_tv_set= tyCoVarsOfTypes inst_tys - -- See Note [Naughty record selectors] and Note [Missing record updaters] + -- See Note [Naughty record selectors] and Note [Naughty record updaters] is_naughty = not (tyCoVarsOfType field_ty `subVarSet` data_tv_set) no_updater = is_naughty || not (isTauTy field_ty) @@ -1010,7 +1010,9 @@ mkRecordSelectorAndUpdater all_cons idDetails fl x_vars y_var = -- Used for both pattern and record construction, to create -- { fld1 = k fld1, .., fldN = k fldN } -- where k gives the hsRecFieldArg for each field - rec_fields :: ConLike -> (FieldLabel -> a) -> HsRecFields GhcRn (Located a) + rec_fields :: ConLike + -> (FieldLabelNoUpdater -> a) + -> HsRecFields GhcRn (Located a) rec_fields con k = HsRecFields { rec_flds = map rec_field (conLikeFieldLabels con) , rec_dotdot = Nothing } @@ -1266,38 +1268,47 @@ Note that: scope. * The Name of each updater is stored alongside that of the selector in the - 'FieldLabelWithUpdate's in each 'DataCon'. + 'FieldLabel's in each 'DataCon'. * Renamed-syntax bindings for both a selector and an updater for each field are produced by mkRecordSelectorAndUpdater; these bindings are then type-checked - together normally. We produce renamed syntax rather than attempting to - generate Core terms directly because the corresponding Core terms are rather - complex (e.g. because of worker-wrapper). + together normally. + + * We produce renamed syntax rather than attempting to generate Core terms + directly because the corresponding Core terms are rather complex. This is + because they include the code necessary to evaluate strict fields, and to + pack/unpack UNPACKed fields, i.e. everything that is handled by the + constructor wrapper, and by dataConBoxer when desugaring pattern matching. + See Note [Generating updaters in advance]. * In some cases we may not be able to generate an updater and will bind its name to () instead, even if we can generate the corresponding selector. See - Note [Missing record updaters]. + Note [Naughty record updaters]. -Note [Missing record updaters] +Note [Naughty record updaters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a few cases in which we cannot generate an updater for a field: - * The field has an existential tyvar, e.g. +1. The field has an existential tyvar, e.g. data T = forall a . MkT { foo :: a } This is the same as for selectors (see Note [Naughty record selectors]). - * The field is higher-rank, e.g. +2. The field is higher-rank, e.g. data T = MkT { foo :: forall a . a -> a } as this would require an impredicative instantiation of (,). - * The field kind is not Type, e.g. +3. The field kind is not Type, e.g. data T = MkT { foo :: Addr# } as this would require an ill-kinded application of (,). -If any of these apply, we bind $upd:foo:MkT to (), just like for naughty -record selectors. This means that when trying to generate a HasField instance, -we need to check if the updater is () and if so give up. +Every field with a naughty record selector also has a naughty record updater +(because the condition 1 is the same for both). However, some types will have a +naughty updater but a regular selector (where conditions 2 or 3 apply). + +If any of these apply, we bind $upd:foo:MkT to (), just as a naughty record +selector is bound to (). This means that when trying to generate a HasField +instance, we need to check if the updater is () and if so give up. Note [Generating updaters in advance] @@ -1324,6 +1335,40 @@ For record pattern synonyms, we generate a selector function, but not an updater. The updater function is not necessary because we do not solve HasField constraints for fields defined by pattern synonyms. +That is, given + + pattern MkPair{x,y} = (x, y) + +you can use `x` as a "record selector" in an expression. But the constraint +solver will not automatically solve constraints like `HasField "x" (a, b) a`, so +you cannot directly use expressions such as `getField @"x" (True, False)` or +`setField @"x" p False`, and RecordDotSyntax will not natively support record +pattern synonyms. + +This can be worked around by the user user manually writing an explicit +HasField instance, such as + + instance HasField "x" (a,b) a where + hasField (x,y) = (\x' -> (x',y), x) + +which will be subject to the usual rules around orphan instances and the +restrictions on when HasField instances can be defined (as described in +Note [Validity checking of HasField instances] in GHC.Tc.Validity). + +We could imagine allowing record pattern synonyms to lead to automatic HasField +constraint solving, but this potentially introduces incoherent HasField +instances, because multiple pattern synonyms (in different modules) might use +the same field name in the same type, and would even lead to e.g. + + pattern Id{id} = id + +introducing an `id` field to *every* type! + +Given the possibility of incoherence, and the fact that a reasonable workaround +exists, we do not currently solve HasField constraints for fields defined by +pattern synonyms. And since we do not need updaters for anything other than +solving HasField constraints, we do not generate them for pattern synonyms. + -} ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -98,7 +98,7 @@ import GHC.Core.TyCon ( TyCon, tyConKind ) import GHC.Core.PatSyn ( PatSyn ) import GHC.Core.Lint ( lintAxioms ) import GHC.Types.Id ( idType, idName ) -import GHC.Types.FieldLabel ( FieldLabelWithUpdate ) +import GHC.Types.FieldLabel ( FieldLabel ) import GHC.Core.UsageEnv import GHC.Tc.Utils.TcType import GHC.Tc.Types.Constraint @@ -640,7 +640,7 @@ tcVisibleOrphanMods tcg_env instance ContainsModule TcGblEnv where extractModule env = tcg_semantic_mod env -type RecFieldEnv = NameEnv [FieldLabelWithUpdate] +type RecFieldEnv = NameEnv [FieldLabel] -- Maps a constructor name *in this module* -- to the fields for that constructor. -- This is used when dealing with ".." notation in record ===================================== compiler/GHC/Types/Avail.hs ===================================== @@ -64,7 +64,7 @@ data AvailInfo Name -- ^ The name of the type or class [Name] -- ^ The available pieces of type or class, -- excluding field selectors. - [FieldLabel] -- ^ The record fields of the type + [FieldLabelNoUpdater] -- ^ The record fields of the type -- (see Note [Representing fields in AvailInfo]). deriving ( Eq -- ^ Used when deciding if the interface has changed @@ -174,7 +174,7 @@ availNonFldNames (Avail n) = [n] availNonFldNames (AvailTC _ ns _) = ns -- | Fields made available by the availability information -availFlds :: AvailInfo -> [FieldLabel] +availFlds :: AvailInfo -> [FieldLabelNoUpdater] availFlds (AvailTC _ _ fs) = fs availFlds _ = [] ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -59,25 +59,27 @@ Of course, datatypes with no constructors cannot have any fields. Note [Updater names] ~~~~~~~~~~~~~~~~~~~~ -As well as the name of the selector for a field label, we sometimes need to -store the name of the updater, which is a pre-generated function for updating a -sole field of a record. See Note [Record updaters] in GHC.Tc.TyCl.Utils, which -describes how updaters are constructed and used. +A record "updater" is a pre-generated function for updating a single field of a +record, just as a selector is a pre-generated function for accessing a single +field. See Note [Record updaters] in GHC.Tc.TyCl.Utils, which describes how +updaters are constructed and used. -However, in some circumstance we do not need the updater name: +Field labels usually store both the name of the selector and the name of the +updater. However, there are two cases in which we do not need the updater name, +so we store the selector only: * The renamer uses the selector name to uniquely identify the field, but the updater name is irrelevant for renaming, so field labels with only selector - names appear in AvailInfo and IE. (Arguably it might be better for the - renamer not to rely on the selector name like this, but changing it would be - a major effort.) + names appear in AvailInfo and IEThingWith. (Arguably it might be better for + the renamer not to rely on the selector name like this, but changing it would + be a major effort.) * Record pattern synonyms do not have updaters, but they do contain field labels. (See Note [No updaters for pattern synonyms] in GHC.Tc.TyCl.Utils.) The FieldLbl type is parameterised over the representations of updater names and selector names, so we can vary whether updater names are available -(FieldLabelWithUpdate) or not (FieldLabel). +(FieldLabel) or not (FieldLabelNoUpdater). -} @@ -92,10 +94,9 @@ module GHC.Types.FieldLabel , FieldLabelEnv , FieldLbl(..) , FieldLabel - , FieldLabelWithUpdate + , FieldLabelNoUpdater , mkFieldLabelOccs - , fieldLabelWithoutUpdate - , fieldLabelsWithoutUpdates + , fieldLabelsWithoutUpdaters ) where @@ -116,16 +117,16 @@ import Data.Data type FieldLabelString = FastString -- | A map from labels to all the auxiliary information -type FieldLabelEnv = DFastStringEnv FieldLabelWithUpdate +type FieldLabelEnv = DFastStringEnv FieldLabel --- | Representation of a field where we know the name of the selector function, --- but not the updater. -type FieldLabel = FieldLbl () Name - -- | Representation of a field where we know the names of both the selector and -- updater functions. -type FieldLabelWithUpdate = FieldLbl Name Name +type FieldLabel = FieldLbl Name Name + +-- | Representation of a field where we know the name of the selector function, +-- but not the updater. +type FieldLabelNoUpdater = FieldLbl () Name -- | Fields in an algebraic record type data FieldLbl update_rep selector_rep = FieldLabel { @@ -157,12 +158,12 @@ instance (Binary a, Binary b) => Binary (FieldLbl a b) where -- | Drop the updater names from a field label (see Note [Updater names]). -fieldLabelWithoutUpdate :: FieldLabelWithUpdate -> FieldLabel -fieldLabelWithoutUpdate fl = fl { flUpdate = () } +fieldLabelWithoutUpdater :: FieldLabel -> FieldLabelNoUpdater +fieldLabelWithoutUpdater fl = fl { flUpdate = () } -- | Drop the updater names from a list of field labels. -fieldLabelsWithoutUpdates :: [FieldLabelWithUpdate] -> [FieldLabel] -fieldLabelsWithoutUpdates = map fieldLabelWithoutUpdate +fieldLabelsWithoutUpdaters :: [FieldLabel] -> [FieldLabelNoUpdater] +fieldLabelsWithoutUpdaters = map fieldLabelWithoutUpdater -- | Record selector OccNames are built from the underlying field name ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -753,7 +753,7 @@ availFromGRE (GRE { gre_name = me, gre_par = parent }) | otherwise -> avail me FldParent p mb_lbl -> AvailTC p [] [mkFieldLabel me mb_lbl] -mkFieldLabel :: Name -> Maybe FastString -> FieldLabel +mkFieldLabel :: Name -> Maybe FastString -> FieldLabelNoUpdater mkFieldLabel me mb_lbl = case mb_lbl of Nothing -> FieldLabel { flLabel = occNameFS (nameOccName me) @@ -814,7 +814,7 @@ lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt lookupGRE_Name env name = lookupGRE_Name_OccName env name (nameOccName name) -lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt +lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLbl a Name -> Maybe GlobalRdrElt -- ^ Look for a particular record field selector in the environment, where the -- selector name and field label may be different: the GlobalRdrEnv is keyed on -- the label. See Note [Parents for record fields] for why this happens. ===================================== compiler/GHC/Types/Name/Shape.hs ===================================== @@ -185,14 +185,15 @@ substNameAvailInfo hsc_env env (AvailTC n ns fs) = let mb_mod = fmap nameModule (lookupNameEnv env n) in AvailTC (substName env n) <$> mapM (initIfaceLoad hsc_env . setNameModule mb_mod) ns - <*> mapM (setNameFieldSelector hsc_env mb_mod) fs + <*> mapM (setNameFieldLabel hsc_env mb_mod) fs --- | Set the 'Module' of a 'FieldSelector' -setNameFieldSelector :: HscEnv -> Maybe Module -> FieldLabel -> IO FieldLabel -setNameFieldSelector _ Nothing f = return f -setNameFieldSelector hsc_env mb_mod (FieldLabel l b () sel) = do +-- | Set the 'Module' of a 'FieldLabelNoUpdater' +setNameFieldLabel :: HscEnv -> Maybe Module -> FieldLabelNoUpdater + -> IO FieldLabelNoUpdater +setNameFieldLabel _ Nothing f = return f +setNameFieldLabel hsc_env mb_mod fl@(FieldLabel {flSelector = sel }) = do sel' <- initIfaceLoad hsc_env $ setNameModule mb_mod sel - return (FieldLabel l b () sel') + return (fl { flSelector = sel' }) {- ************************************************************************ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca5801f1157f0732e8b5656bc4bc636b4c08e06f...fdff0fe1834729148842ac0d7b94e68a9c916466 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca5801f1157f0732e8b5656bc4bc636b4c08e06f...fdff0fe1834729148842ac0d7b94e68a9c916466 You're receiving 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 12 20:22:23 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sat, 12 Sep 2020 16:22:23 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] 54 commits: configure: Work around Raspbian's silly packaging decisions Message-ID: <5f5d2dff6218b_80b3f8487fb075c117708d9@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples 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 - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 7590dfb6 by Ryan Scott at 2020-09-12T16:18:51-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 ------------------------- - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.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/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/840ec0435f9e117dd56de4fde74af1434b527891...7590dfb6514d2f898908bec428334cff7d116326 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/840ec0435f9e117dd56de4fde74af1434b527891...7590dfb6514d2f898908bec428334cff7d116326 You're receiving 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 12 21:10:40 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 12 Sep 2020 17:10:40 -0400 Subject: [Git][ghc/ghc][wip/T18302] 58 commits: Turn on -XMonoLocalBinds by default (#18430) Message-ID: <5f5d39507e045_80b3f845948c4f8117805ae@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18302 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 - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 6e0fe26d by Krzysztof Gogolewski at 2020-09-12T23:10:21+02:00 WIP on #18302 Culprit: pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] -- ^ Pick GREs that are in scope *both* qualified *and* unqualified -- Return each GRE that is, as a pair -- (qual_gre, unqual_gre) -- These two GREs are the original GRE with imports filtered to express how -- it is in scope qualified an unqualified respectively -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) pickBothGRE mod gre@(GRE { gre_name = n }) | isBuiltInSyntax n = Nothing | Just gre1 <- pickQualGRE mod gre , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) | otherwise = Nothing where -- isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the -- cluttered envt is no use. Really, it's only useful for -- GHC.Base and GHC.Tuple. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Prim.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/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4edcde70160820dd23c53d9019f895930e2c0e7...6e0fe26d365928341d2e78df8d205810f86752f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4edcde70160820dd23c53d9019f895930e2c0e7...6e0fe26d365928341d2e78df8d205810f86752f7 You're receiving 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 12 21:53:31 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 12 Sep 2020 17:53:31 -0400 Subject: [Git][ghc/ghc][wip/T18302] WIP on #18302 Message-ID: <5f5d435b9e681_80b3f84300acca811780790@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18302 at Glasgow Haskell Compiler / GHC Commits: 5f15edd2 by Krzysztof Gogolewski at 2020-09-12T23:52:48+02:00 WIP on #18302 Culprit: pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] -- ^ Pick GREs that are in scope *both* qualified *and* unqualified -- Return each GRE that is, as a pair -- (qual_gre, unqual_gre) -- These two GREs are the original GRE with imports filtered to express how -- it is in scope qualified an unqualified respectively -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) pickBothGRE mod gre@(GRE { gre_name = n }) | isBuiltInSyntax n = Nothing | Just gre1 <- pickQualGRE mod gre , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) | otherwise = Nothing where -- isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the -- cluttered envt is no use. Really, it's only useful for -- GHC.Base and GHC.Tuple. - - - - - 2 changed files: - compiler/GHC/Builtin/Types/Prim.hs - libraries/base/Unsafe/Coerce.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -11,8 +11,6 @@ Wired-in knowledge about primitive types -- | This module defines TyCons that can't be expressed in Haskell. -- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types" module GHC.Builtin.Types.Prim( - mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only - mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, mkTemplateKiTyVars, mkTemplateKiTyVar, @@ -402,7 +400,7 @@ multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13 -- selects ' -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon +funTyConName = mkPrimTcName UserSyntax (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- @@ -536,12 +534,7 @@ tYPETyCon = mkKindTyCon tYPETyConName -- If you edit these, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon - -mkPrimTyConName :: FastString -> Unique -> TyCon -> Name -mkPrimTyConName = mkPrimTcName BuiltInSyntax - -- All of the super kinds and kinds are defined in Prim, - -- and use BuiltInSyntax, because they are never in scope in the source +tYPETyConName = mkPrimTcName UserSyntax (fsLit "TYPE") tYPETyConKey tYPETyCon mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name mkPrimTcName built_in_syntax occ key tycon ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -24,8 +24,6 @@ import GHC.Arr (amap) -- For amap/unsafeCoerce rule import GHC.Base import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base -import GHC.Types - {- Note [Implementing unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementation of unsafeCoerce is surprisingly subtle. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f15edd28eafd5a6bf74d429a85785dbf092eb20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f15edd28eafd5a6bf74d429a85785dbf092eb20 You're receiving 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 12 22:53:08 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 12 Sep 2020 18:53:08 -0400 Subject: [Git][ghc/ghc][wip/T18302] WIP on #18302 Message-ID: <5f5d51546cc03_80b3f84693a32d4117906b1@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18302 at Glasgow Haskell Compiler / GHC Commits: 80586003 by Krzysztof Gogolewski at 2020-09-13T00:52:48+02:00 WIP on #18302 Culprit: pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] -- ^ Pick GREs that are in scope *both* qualified *and* unqualified -- Return each GRE that is, as a pair -- (qual_gre, unqual_gre) -- These two GREs are the original GRE with imports filtered to express how -- it is in scope qualified an unqualified respectively -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) pickBothGRE mod gre@(GRE { gre_name = n }) | isBuiltInSyntax n = Nothing | Just gre1 <- pickQualGRE mod gre , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) | otherwise = Nothing where -- isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the -- cluttered envt is no use. Really, it's only useful for -- GHC.Base and GHC.Tuple. - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/Unsafe/Coerce.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -11,8 +11,6 @@ Wired-in knowledge about primitive types -- | This module defines TyCons that can't be expressed in Haskell. -- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types" module GHC.Builtin.Types.Prim( - mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only - mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, mkTemplateKiTyVars, mkTemplateKiTyVar, @@ -402,7 +400,7 @@ multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13 -- selects ' -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon +funTyConName = mkPrimTcName UserSyntax (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- @@ -536,12 +534,7 @@ tYPETyCon = mkKindTyCon tYPETyConName -- If you edit these, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon - -mkPrimTyConName :: FastString -> Unique -> TyCon -> Name -mkPrimTyConName = mkPrimTcName BuiltInSyntax - -- All of the super kinds and kinds are defined in Prim, - -- and use BuiltInSyntax, because they are never in scope in the source +tYPETyConName = mkPrimTcName UserSyntax (fsLit "TYPE") tYPETyConKey tYPETyCon mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name mkPrimTcName built_in_syntax occ key tycon ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -82,10 +82,9 @@ module Data.Typeable.Internal ( typeSymbolTypeRep, typeNatTypeRep, ) where -import GHC.Prim ( FUN ) import GHC.Base import qualified GHC.Arr as A -import GHC.Types ( TYPE, Multiplicity (Many) ) +import GHC.Types ( Multiplicity (Many) ) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -24,8 +24,6 @@ import GHC.Arr (amap) -- For amap/unsafeCoerce rule import GHC.Base import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base -import GHC.Types - {- Note [Implementing unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementation of unsafeCoerce is surprisingly subtle. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/805860036723e09506b1fa51927f7ca2bd6f2e58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/805860036723e09506b1fa51927f7ca2bd6f2e58 You're receiving 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 13 00:54:56 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sat, 12 Sep 2020 20:54:56 -0400 Subject: [Git][ghc/ghc][wip/T18302] WIP on #18302 Message-ID: <5f5d6de0e0eb0_80b3f8468eb7d2411795254@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18302 at Glasgow Haskell Compiler / GHC Commits: 3c83a684 by Krzysztof Gogolewski at 2020-09-13T02:53:45+02:00 WIP on #18302 Culprit: pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] -- ^ Pick GREs that are in scope *both* qualified *and* unqualified -- Return each GRE that is, as a pair -- (qual_gre, unqual_gre) -- These two GREs are the original GRE with imports filtered to express how -- it is in scope qualified an unqualified respectively -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) pickBothGRE mod gre@(GRE { gre_name = n }) | isBuiltInSyntax n = Nothing | Just gre1 <- pickQualGRE mod gre , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) | otherwise = Nothing where -- isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the -- cluttered envt is no use. Really, it's only useful for -- GHC.Base and GHC.Tuple. - - - - - 4 changed files: - compiler/GHC/Builtin/Types/Prim.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Exception.hs - libraries/base/Unsafe/Coerce.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -11,8 +11,6 @@ Wired-in knowledge about primitive types -- | This module defines TyCons that can't be expressed in Haskell. -- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types" module GHC.Builtin.Types.Prim( - mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only - mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, mkTemplateKiTyVars, mkTemplateKiTyVar, @@ -402,7 +400,7 @@ multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13 -- selects ' -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon +funTyConName = mkPrimTcName UserSyntax (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- @@ -536,12 +534,7 @@ tYPETyCon = mkKindTyCon tYPETyConName -- If you edit these, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon - -mkPrimTyConName :: FastString -> Unique -> TyCon -> Name -mkPrimTyConName = mkPrimTcName BuiltInSyntax - -- All of the super kinds and kinds are defined in Prim, - -- and use BuiltInSyntax, because they are never in scope in the source +tYPETyConName = mkPrimTcName UserSyntax (fsLit "TYPE") tYPETyConKey tYPETyCon mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name mkPrimTcName built_in_syntax occ key tycon ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -82,10 +82,9 @@ module Data.Typeable.Internal ( typeSymbolTypeRep, typeNatTypeRep, ) where -import GHC.Prim ( FUN ) import GHC.Base import qualified GHC.Arr as A -import GHC.Types ( TYPE, Multiplicity (Many) ) +import GHC.Types ( Multiplicity (Many) ) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Base import GHC.Show import GHC.Stack.Types import GHC.OldList -import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS import GHC.Exception.Type ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -24,8 +24,6 @@ import GHC.Arr (amap) -- For amap/unsafeCoerce rule import GHC.Base import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base -import GHC.Types - {- Note [Implementing unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementation of unsafeCoerce is surprisingly subtle. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c83a684346a9fc0fc60fe933a19cf167f23bfd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c83a684346a9fc0fc60fe933a19cf167f23bfd2 You're receiving 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 13 01:27:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 21:27:09 -0400 Subject: [Git][ghc/ghc][master] Avoid iterating twice in `zipTyEnv` (#18535) Message-ID: <5f5d756dd3f6f_80b3f84941f5dbc11795810@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 2 changed files: - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Types/Unique/FM.hs Changes: ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -440,7 +440,7 @@ zipTyEnv tyvars tys = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) | otherwise = ASSERT( all (not . isCoercionTy) tys ) - mkVarEnv (zipEqual "zipTyEnv" tyvars tys) + zipToUFM tyvars tys -- There used to be a special case for when -- ty == TyVarTy tv -- (a not-uncommon case) in which case the substitution was dropped. ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -23,6 +23,7 @@ of arguments of combining function. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.FM ( @@ -34,6 +35,7 @@ module GHC.Types.Unique.FM ( emptyUFM, unitUFM, unitDirectlyUFM, + zipToUFM, listToUFM, listToUFM_Directly, listToUFM_C, @@ -75,11 +77,14 @@ module GHC.Types.Unique.FM ( pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM ) where +#include "HsVersions.h" + import GHC.Prelude import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) import GHC.Utils.Outputable - +import GHC.Utils.Panic (assertPanic) +import GHC.Utils.Misc (debugIsOn) import qualified Data.IntMap as M import qualified Data.IntSet as S import Data.Data @@ -113,6 +118,19 @@ unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v) unitDirectlyUFM :: Unique -> elt -> UniqFM key elt unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) +-- zipToUFM ks vs = listToUFM (zip ks vs) +-- This function exists because it's a common case (#18535), and +-- it's inefficient to first build a list of pairs, and then immediately +-- take it apart. Astonishingly, fusing this one list away reduces total +-- compiler allocation by more than 10% (in T12545, see !3935) +-- Note that listToUFM (zip ks vs) performs similarly, but +-- the explicit recursion avoids relying too much on fusion. +zipToUFM :: Uniquable key => [key] -> [elt] -> UniqFM key elt +zipToUFM ks vs = ASSERT( length ks == length vs ) innerZip emptyUFM ks vs + where + innerZip ufm (k:kList) (v:vList) = innerZip (addToUFM ufm k v) kList vList + innerZip ufm _ _ = ufm + listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2157be52cd454353582b04d89492b239b90f91f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2157be52cd454353582b04d89492b239b90f91f7 You're receiving 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 13 01:27:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 12 Sep 2020 21:27:50 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f5d759668ba1_80b3f84871edd18118015ab@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 16 changed files: - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/ghc.cabal.in - + 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/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,7 +37,6 @@ 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.Data.Bag import GHC.Types.Name.Reader @@ -58,6 +58,7 @@ import GHC.Hs.Extension import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe +import qualified Data.Kind {- ************************************************************************ @@ -89,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/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/PmCheck/Oracle.hs ===================================== @@ -584,13 +584,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) @@ -597,15 +596,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/HsToCore/Types.hs ===================================== @@ -0,0 +1,85 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + +-- | 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 (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) + +{- +************************************************************************ +* * + 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 + +-- See Note [The Decoupling Abstract Data Hack] +type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) ===================================== 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/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 ===================================== 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 ===================================== @@ -314,6 +314,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call ===================================== 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/-/compare/2157be52cd454353582b04d89492b239b90f91f7...fd5d622a5ee283d3c1f1ccd28b4f73aab30d7d9f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2157be52cd454353582b04d89492b239b90f91f7...fd5d622a5ee283d3c1f1ccd28b4f73aab30d7d9f You're receiving 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 13 01:41:04 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Sat, 12 Sep 2020 21:41:04 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] :broom: Message-ID: <5f5d78b0b1fdb_80b3f8486807ba0118038b9@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 959333dc by Moritz Angermann at 2020-09-13T01:40:52+00:00 :broom: - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections import GHC.Data.Graph.Directed import GHC.Utils.Panic -import GHC.Utils.Outputable import GHC.Utils.Monad (concatMapM) import GHC.Types.Unique import GHC.Types.Unique.FM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/959333dca363eee20ac4575cade5c77742197e6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/959333dca363eee20ac4575cade5c77742197e6d You're receiving 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 13 03:22:59 2020 From: gitlab at gitlab.haskell.org (Leif Metcalf) Date: Sat, 12 Sep 2020 23:22:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/trivial-readme Message-ID: <5f5d90938fe18_80b3f8439e05ce81180768e@gitlab.haskell.org.mail> Leif Metcalf pushed new branch wip/trivial-readme at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/trivial-readme You're receiving 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 13 04:27:00 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Sun, 13 Sep 2020 00:27:00 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] sftu for now. Message-ID: <5f5d9f942ee64_80b6cb61f4118101e@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: d8c0771f by Moritz Angermann at 2020-09-13T04:26:50+00:00 sftu for now. - - - - - 1 changed file: - docs/users_guide/expected-undocumented-flags.txt Changes: ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -146,3 +146,8 @@ -ticky-LNE -ticky-allocd -ticky-dyn-thunk +-fasm-immload +-fasm-jumptables +-fasm-negoffset +-fasm-regoffsets +-fasm-usezeroreg View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8c0771fcbcba1ce2b6bdbbd8875cf8dd03c3f5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8c0771fcbcba1ce2b6bdbbd8875cf8dd03c3f5d You're receiving 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 13 12:01:30 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 13 Sep 2020 08:01:30 -0400 Subject: [Git][ghc/ghc][wip/T18302] WIP on #18302 Message-ID: <5f5e0a1ad0364_80b3f848695af98118297de@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18302 at Glasgow Haskell Compiler / GHC Commits: 379e4de0 by Krzysztof Gogolewski at 2020-09-13T14:01:07+02:00 WIP on #18302 Culprit: pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] -- ^ Pick GREs that are in scope *both* qualified *and* unqualified -- Return each GRE that is, as a pair -- (qual_gre, unqual_gre) -- These two GREs are the original GRE with imports filtered to express how -- it is in scope qualified an unqualified respectively -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) pickBothGRE mod gre@(GRE { gre_name = n }) | isBuiltInSyntax n = Nothing | Just gre1 <- pickQualGRE mod gre , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) | otherwise = Nothing where -- isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the -- cluttered envt is no use. Really, it's only useful for -- GHC.Base and GHC.Tuple. - - - - - 5 changed files: - compiler/GHC/Builtin/Types/Prim.hs - libraries/base/Data/Typeable/Internal.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Exts.hs - libraries/base/Unsafe/Coerce.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -11,8 +11,6 @@ Wired-in knowledge about primitive types -- | This module defines TyCons that can't be expressed in Haskell. -- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types" module GHC.Builtin.Types.Prim( - mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only - mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, mkTemplateKiTyVars, mkTemplateKiTyVar, @@ -402,7 +400,7 @@ multiplicityTyVar = mkTemplateTyVars (repeat multiplicityTy) !! 13 -- selects ' -} funTyConName :: Name -funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon +funTyConName = mkPrimTcName UserSyntax (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- @@ -536,12 +534,7 @@ tYPETyCon = mkKindTyCon tYPETyConName -- If you edit these, you may need to update the GHC formalism -- See Note [GHC Formalism] in GHC.Core.Lint -tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon - -mkPrimTyConName :: FastString -> Unique -> TyCon -> Name -mkPrimTyConName = mkPrimTcName BuiltInSyntax - -- All of the super kinds and kinds are defined in Prim, - -- and use BuiltInSyntax, because they are never in scope in the source +tYPETyConName = mkPrimTcName UserSyntax (fsLit "TYPE") tYPETyConKey tYPETyCon mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name mkPrimTcName built_in_syntax occ key tycon ===================================== libraries/base/Data/Typeable/Internal.hs ===================================== @@ -82,10 +82,9 @@ module Data.Typeable.Internal ( typeSymbolTypeRep, typeNatTypeRep, ) where -import GHC.Prim ( FUN ) import GHC.Base import qualified GHC.Arr as A -import GHC.Types ( TYPE, Multiplicity (Many) ) +import GHC.Types ( Multiplicity (Many) ) import Data.Type.Equality import GHC.List ( splitAt, foldl', elem ) import GHC.Word ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Base import GHC.Show import GHC.Stack.Types import GHC.OldList -import GHC.Prim import GHC.IO.Unsafe import {-# SOURCE #-} GHC.Stack.CCS import GHC.Exception.Type ===================================== libraries/base/GHC/Exts.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Exts maxTupleSize, -- * Primitive operations - FUN, -- See https://gitlab.haskell.org/ghc/ghc/issues/18302 module GHC.Prim, module GHC.Prim.Ext, shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#, @@ -91,7 +90,7 @@ module GHC.Exts type (~~), -- * Representation polymorphism - GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..), + RuntimeRep(..), VecCount(..), VecElem(..), -- * Transform comprehensions Down(..), groupWith, sortWith, the, ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -24,8 +24,6 @@ import GHC.Arr (amap) -- For amap/unsafeCoerce rule import GHC.Base import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base -import GHC.Types - {- Note [Implementing unsafeCoerce] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementation of unsafeCoerce is surprisingly subtle. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379e4de0d59b88c3d3fcae3bc26c4f32a9e51c73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/379e4de0d59b88c3d3fcae3bc26c4f32a9e51c73 You're receiving 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 13 13:01:34 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sun, 13 Sep 2020 09:01:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18662 Message-ID: <5f5e182e7923a_80b3f8491b8bab41183823e@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18662 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18662 You're receiving 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 13 14:29:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 13 Sep 2020 10:29:15 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump version to 9.0 Message-ID: <5f5e2cbb8fb8d_80b3f848c2814f011843942@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: c1a1d93b by Ben Gamari at 2020-09-13T10:29:02-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (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 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit b95f6f29899a8a58223732a6633a47a35b8f1d6a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1a1d93bb15ea84b0bf4e6db9bb9ce6e40123049 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1a1d93bb15ea84b0bf4e6db9bb9ce6e40123049 You're receiving 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 14 02:48:54 2020 From: gitlab at gitlab.haskell.org (Leif Metcalf) Date: Sun, 13 Sep 2020 22:48:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/z-encoding-note Message-ID: <5f5eda16612ce_80b3f849a4cddb811878422@gitlab.haskell.org.mail> Leif Metcalf pushed new branch wip/z-encoding-note at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/z-encoding-note You're receiving 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 14 02:58:07 2020 From: gitlab at gitlab.haskell.org (Josh Meredith) Date: Sun, 13 Sep 2020 22:58:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/coreField8102 Message-ID: <5f5edc3f69019_80b10e661481188007c@gitlab.haskell.org.mail> Josh Meredith pushed new branch wip/coreField8102 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/coreField8102 You're receiving 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 14 12:17:31 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Sep 2020 08:17:31 -0400 Subject: [Git][ghc/ghc][wip/T18126] 3 commits: QL wibbles following RAE review Message-ID: <5f5f5f5b3462b_80b3f8469efc25c11901054@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: c707d999 by Simon Peyton Jones at 2020-09-14T13:12:05+01:00 QL wibbles following RAE review - - - - - 2e5c372a by Simon Peyton Jones at 2020-09-14T13:15:33+01:00 QL wibbles following RAE review - - - - - 4c56d0af by Simon Peyton Jones at 2020-09-14T13:16:50+01:00 wibbles generalilsation - - - - - 14 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcMType.hs - docs/users_guide/exts/impredicative_types.rst - docs/users_guide/ghci.rst - testsuite/tests/impredicative/all.T - + testsuite/tests/impredicative/expr-sig.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -102,7 +102,7 @@ tcInferSigma inst (L loc rn_expr) = addExprCtxt rn_expr $ setSrcSpan loc $ do { do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args + ; (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args Nothing ; (_delta, inst_args, app_res_sigma) <- tcInstFun do_ql inst rn_fun fun_sigma rn_args ; _tc_args <- tcValArgs do_ql tc_fun inst_args ; return app_res_sigma } @@ -133,7 +133,10 @@ head ::= f -- HsVar: variables When tcExpr sees something that starts an application chain (namely, any of the constructors in 'app' or 'head'), it invokes tcApp to -typecheck it: see Note [tcApp: typechecking applications]. +typecheck it: see Note [tcApp: typechecking applications]. However, +for HsPar and HsPragE, there is no tcWrapResult (which would +instantiate types, bypassing Quick Look), so nothing is gained by +using the application chain route, and we can just recurse to tcExpr. A "head" has three special cases (for which we can infer a polytype using tcInferAppHead_maybe); otherwise is just any old expression (for @@ -142,6 +145,14 @@ which we can infer a rho-type (via tcInfer). There is no special treatment for HsUnboundVar, HsOverLit etc, because we can't get a polytype from them. +It may not be immediately obvious why ExprWithTySig (e::ty) should be +dealt with by tcApp, even when it is not applied to anything. Consider + f :: [forall a. a->a] -> Int + ...(f (undefined :: forall b. b))... +Clearly this should work! But it will /only/ work because if we +instantiate that (forall b. b) impredicatively! And that only happens +in tcApp. + Note [tcApp: typechecking applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tcApp implements the APP-Downarrow/Uparrow rule of @@ -211,6 +222,7 @@ tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcApp rn_expr exp_res_ty | (rn_fun, rn_args, rebuild) <- splitHsApps rn_expr = do { (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args + (checkingExpType_maybe exp_res_ty) -- Instantiate ; do_ql <- wantQuickLook rn_fun @@ -706,7 +718,7 @@ quickLookArg1 :: Bool -> Delta -> LHsExpr GhcRn -> TcSigmaType quickLookArg1 guarded delta larg@(L loc arg) arg_ty = setSrcSpan loc $ do { let (rn_fun,rn_args,rebuild) = splitHsApps arg - ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args + ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args (Just arg_ty) ; traceTc "quickLookArg 1" $ vcat [ text "arg:" <+> ppr arg , text "head:" <+> ppr rn_fun <+> dcolon <+> ppr mb_fun_ty ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Tc.Gen.Expr ( tcCheckPolyExpr, tcCheckPolyExprNC, tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC, tcInferRho, tcInferRhoNC, - tcExpr, tcExprWithSig, + tcExpr, tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, tcCheckId, addAmbiguousNameErr, @@ -39,9 +39,7 @@ import GHC.Core.UsageEnv import GHC.Tc.Utils.Instantiate import GHC.Tc.Gen.App import GHC.Tc.Gen.Head -import GHC.Tc.Gen.Bind ( chooseInferredQuantifiers, tcLocalBinds ) -import GHC.Tc.Gen.Sig ( tcUserTypeSig, tcInstSig ) -import GHC.Tc.Solver ( simplifyInfer, InferMode(..) ) +import GHC.Tc.Gen.Bind ( tcLocalBinds ) import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Rename.Env ( addUsedGRE ) @@ -63,7 +61,6 @@ import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Core.TyCon -import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Types.Evidence import GHC.Types.Var.Set @@ -183,9 +180,13 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- - HsVar: lone variables, to ensure that they can get an -- impredicative instantiation (via Quick Look -- driven by res_ty (in checking mode). -tcExpr e@(HsVar {}) res_ty = tcApp e res_ty -tcExpr e@(HsApp {}) res_ty = tcApp e res_ty -tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty +-- - ExprWithTySig: (e :: type) +-- See Note [Application chains and heads] in GHC.Tc.Gen.App +tcExpr e@(HsVar {}) res_ty = tcApp e res_ty +tcExpr e@(HsApp {}) res_ty = tcApp e res_ty +tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty +tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty +tcExpr e@(HsRecFld {}) res_ty = tcApp e res_ty -- Typecheck an occurrence of an unbound Id -- @@ -287,10 +288,6 @@ tcExpr e@(HsLamCase x matches) res_ty , text "requires"] match_ctxt = MC { mc_what = CaseAlt, mc_body = tcBody } -tcExpr e@(ExprWithTySig _ expr hs_ty) res_ty - = do { (expr', poly_ty) <- tcExprWithSig expr hs_ty - ; tcWrapResult e expr' poly_ty res_ty } - {- Note [Type-checking overloaded labels] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -910,8 +907,6 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty ; tcWrapResult expr expr' rec_res_ty res_ty } -tcExpr e@(HsRecFld _ f) res_ty - = tcCheckRecSelId e f res_ty {- ************************************************************************ @@ -1066,7 +1061,9 @@ tcSyntaxOpGen :: CtOrigin -> ([TcSigmaType] -> [Mult] -> TcM a) -> TcM (a, SyntaxExprTc) tcSyntaxOpGen orig (SyntaxExprRn op) arg_tys res_ty thing_inside - = do { (expr, sigma) <- tcInferAppHead op [] + = do { (expr, sigma) <- tcInferAppHead op [] Nothing + -- Nothing here might be improved, but all this + -- code is scheduled for demolition anyway ; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma) ; (result, expr_wrap, arg_wraps, res_wrap) <- tcSynArgA orig sigma arg_tys res_ty $ @@ -1239,99 +1236,6 @@ Here's an example where it actually makes a real difference With the change, f1 will type-check, because the 'Char' info from the signature is propagated into MkQ's argument. With the check in the other order, the extra signature in f2 is reqd. - -************************************************************************ -* * - Expressions with a type signature - expr :: type -* * -********************************************************************* -} - -tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn) - -> TcM (HsExpr GhcTc, TcSigmaType) -tcExprWithSig expr hs_ty - = do { sig_info <- checkNoErrs $ -- Avoid error cascade - tcUserTypeSig loc hs_ty Nothing - ; (expr', poly_ty) <- tcExprSig expr sig_info - ; return (ExprWithTySig noExtField expr' hs_ty, poly_ty) } - where - loc = getLoc (hsSigWcType hs_ty) - -tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) -tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) - = setSrcSpan loc $ -- Sets the location for the implication constraint - do { let poly_ty = idType poly_id - ; (wrap, expr') <- tcSkolemiseScoped ExprSigCtxt poly_ty $ \rho_ty -> - tcCheckMonoExprNC expr rho_ty - ; return (mkLHsWrap wrap expr', poly_ty) } - -tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) - = setSrcSpan loc $ -- Sets the location for the implication constraint - do { (tclvl, wanted, (expr', sig_inst)) - <- pushLevelAndCaptureConstraints $ - do { sig_inst <- tcInstSig sig - ; expr' <- tcExtendNameTyVarEnv (mapSnd binderVar $ sig_inst_skols sig_inst) $ - tcExtendNameTyVarEnv (sig_inst_wcs sig_inst) $ - tcCheckPolyExprNC expr (sig_inst_tau sig_inst) - ; return (expr', sig_inst) } - -- See Note [Partial expression signatures] - ; let tau = sig_inst_tau sig_inst - infer_mode | null (sig_inst_theta sig_inst) - , isNothing (sig_inst_wcx sig_inst) - = ApplyMR - | otherwise - = NoRestrictions - ; (qtvs, givens, ev_binds, residual, _) - <- simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted - ; emitConstraints residual - - ; tau <- zonkTcType tau - ; let inferred_theta = map evVarPred givens - tau_tvs = tyCoVarsOfType tau - ; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta - tau_tvs qtvs (Just sig_inst) - ; let inferred_sigma = mkInfSigmaTy qtvs inferred_theta tau - my_sigma = mkInvisForAllTys binders (mkPhiTy my_theta tau) - ; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis. - then return idHsWrapper -- Fast path; also avoids complaint when we infer - -- an ambiguous type and have AllowAmbiguousType - -- e..g infer x :: forall a. F a -> Int - else tcSubTypeSigma ExprSigCtxt inferred_sigma my_sigma - - ; traceTc "tcExpSig" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma) - ; let poly_wrap = wrap - <.> mkWpTyLams qtvs - <.> mkWpLams givens - <.> mkWpLet ev_binds - ; return (mkLHsWrap poly_wrap expr', my_sigma) } - - -{- Note [Partial expression signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Partial type signatures on expressions are easy to get wrong. But -here is a guiding principile - e :: ty -should behave like - let x :: ty - x = e - in x - -So for partial signatures we apply the MR if no context is given. So - e :: IO _ apply the MR - e :: _ => IO _ do not apply the MR -just like in GHC.Tc.Gen.Bind.decideGeneralisationPlan - -This makes a difference (#11670): - peek :: Ptr a -> IO CLong - peek ptr = peekElemOff undefined 0 :: _ -from (peekElemOff undefined 0) we get - type: IO w - constraints: Storable w - -We must NOT try to generalise over 'w' because the signature specifies -no constraints so we'll complain about not being able to solve -Storable w. Instead, don't generalise; then _ gets instantiated to -CLong, as it should. -} {- ********************************************************************* ===================================== compiler/GHC/Tc/Gen/Expr.hs-boot ===================================== @@ -1,11 +1,11 @@ module GHC.Tc.Gen.Expr where import GHC.Hs ( HsExpr, LHsExpr, SyntaxExprRn - , SyntaxExprTc, LHsSigWcType ) + , SyntaxExprTc ) import GHC.Tc.Utils.TcType ( TcRhoType, TcSigmaType, SyntaxOpType, ExpType, ExpRhoType ) import GHC.Tc.Types ( TcM ) import GHC.Tc.Types.Origin ( CtOrigin ) import GHC.Core.Type ( Mult ) -import GHC.Hs.Extension ( GhcRn, GhcTc, NoGhcTc ) +import GHC.Hs.Extension ( GhcRn, GhcTc ) tcCheckPolyExpr, tcCheckPolyExprNC :: LHsExpr GhcRn @@ -23,9 +23,6 @@ tcCheckMonoExpr, tcCheckMonoExprNC :: tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn) - -> TcM (HsExpr GhcTc, TcSigmaType) - tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -19,16 +19,18 @@ module GHC.Tc.Gen.Head , tcInferAppHead, tcInferAppHead_maybe , tcInferId, tcCheckId - , tcCheckRecSelId - , disambiguateSelector, obviousSig, addAmbiguousNameErr + , obviousSig, addAmbiguousNameErr , tyConOf, tyConOfET, lookupParents, fieldNotInType , notSelector, nonBidirectionalErr , exprCtxt, addLExprCtxt, addExprCtxt, addFunResCtxt ) where -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcExprWithSig ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckMonoExprNC, tcCheckPolyExprNC ) -import GHC.Hs +import GHC.Tc.Gen.HsType +import GHC.Tc.Gen.Pat +import GHC.Tc.Gen.Bind( chooseInferredQuantifiers ) +import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig ) import GHC.Tc.TyCl.PatSyn( patSynBuilderOcc ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Unify @@ -39,13 +41,12 @@ import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Core.UsageEnv ( unitUE ) import GHC.Rename.Env ( addUsedGRE ) import GHC.Rename.Utils ( addNameClashErrRn, unknownSubordinateErr ) +import GHC.Tc.Solver ( InferMode(..), simplifyInfer ) import GHC.Tc.Utils.Env -import GHC.Tc.Gen.HsType -import GHC.Tc.Gen.Pat -import GHC.Tc.Gen.Sig( isCompleteHsSig ) import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType +import GHC.Hs import GHC.Types.Id import GHC.Types.Id.Info import GHC.Core.ConLike @@ -317,7 +318,8 @@ pprHsExprArgTc arg = ppr arg ********************************************************************* -} tcInferAppHead :: HsExpr GhcRn - -> [HsExprArg 'TcpRn] + -> [HsExprArg 'TcpRn] -> Maybe TcRhoType + -- These two args are solely for tcInferRecSelId -> TcM (HsExpr GhcTc, TcSigmaType) -- Infer type of the head of an application -- i.e. the 'f' in (f e1 ... en) @@ -339,26 +341,29 @@ tcInferAppHead :: HsExpr GhcRn -- cases are dealt with by splitHsApps. -- -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App -tcInferAppHead fun args - = setSrcSpanFromArgs args $ - do { mb_tc_fun <- tcInferAppHead_maybe fun args +tcInferAppHead fun args mb_res_ty + = setSrcSpanFromArgs args $ + do { mb_tc_fun <- tcInferAppHead_maybe fun args mb_res_ty ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> addExprCtxt fun $ - tcInfer (tcExpr fun) } + Nothing -> tcInfer (tcExpr fun) } tcInferAppHead_maybe :: HsExpr GhcRn - -> [HsExprArg 'TcpRn] + -> [HsExprArg 'TcpRn] -> Maybe TcRhoType + -- These two args are solely for tcInferRecSelId -> TcM (Maybe (HsExpr GhcTc, TcSigmaType)) -- Returns Nothing for a complicated head -tcInferAppHead_maybe fun args +tcInferAppHead_maybe fun args mb_res_ty = case fun of HsVar _ (L _ nm) -> Just <$> tcInferId nm - HsRecFld _ f -> Just <$> tcInferRecSelId f args - ExprWithTySig _ e hs_ty - | isCompleteHsSig hs_ty -> addErrCtxt (exprCtxt fun) $ + HsRecFld _ f -> Just <$> tcInferRecSelId f args mb_res_ty + ExprWithTySig _ e hs_ty -> add_ctxt $ Just <$> tcExprWithSig e hs_ty _ -> return Nothing + where + add_ctxt thing_inside + | null args = thing_inside -- We havea already pushed the context + | otherwise = addExprCtxt fun thing_inside {- ********************************************************************* @@ -456,40 +461,20 @@ non-obvious ways. See also Note [HsRecField and HsRecUpdField] in GHC.Hs.Pat. -} -tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn - -> ExpRhoType -> TcM (HsExpr GhcTc) -tcCheckRecSelId rn_expr (Unambiguous sel_name lbl) res_ty - = do { sel_id <- tc_rec_sel_id lbl sel_name - ; let expr = HsRecFld noExtField (Unambiguous sel_id lbl) - ; tcWrapResult rn_expr expr (idType sel_id) res_ty } -tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty - = case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of - Nothing -> ambiguousSelector lbl - Just (arg, _) -> do { sel_name <- disambiguateSelector lbl (scaledThing arg) - ; sel_id <- tc_rec_sel_id lbl sel_name - ; let expr = HsRecFld noExtField (Ambiguous sel_id lbl) - ; tcWrapResult rn_expr expr (idType sel_id) res_ty } - -tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> [HsExprArg 'TcpRn] +tcInferRecSelId :: AmbiguousFieldOcc GhcRn + -> [HsExprArg 'TcpRn] -> Maybe TcRhoType -> TcM (HsExpr GhcTc, TcSigmaType) --- Disgusting special case for ambiguous record selectors -tcInferRecSelId (Ambiguous _ lbl) args - | arg1 : _ <- dropWhile (not . isVisibleArg) args -- A value arg is first - , EValArg { eva_arg = ValArg (L _ arg) } <- arg1 - , Just sig_ty <- obviousSig arg -- A type sig on the arg disambiguates - = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty - ; sel_name <- disambiguateSelector lbl sig_tc_ty - ; sel_id <- tc_rec_sel_id lbl sel_name - ; let expr = HsRecFld noExtField (Ambiguous sel_id lbl) - ; return (expr, idType sel_id) } - | otherwise - = ambiguousSelector lbl - -tcInferRecSelId (Unambiguous sel_name lbl) _args +tcInferRecSelId (Unambiguous sel_name lbl) _args _mb_res_ty = do { sel_id <- tc_rec_sel_id lbl sel_name ; let expr = HsRecFld noExtField (Unambiguous sel_id lbl) ; return (expr, idType sel_id) } +tcInferRecSelId (Ambiguous _ lbl) args mb_res_ty + = do { sel_name <- tcInferAmbiguousRecSelId lbl args mb_res_ty + ; sel_id <- tc_rec_sel_id lbl sel_name + ; let expr = HsRecFld noExtField (Ambiguous sel_id lbl) + ; return (expr, idType sel_id) } + ------------------------ tc_rec_sel_id :: Located RdrName -> Name -> TcM TcId -- Like tc_infer_id, but returns an Id not a HsExpr, @@ -498,13 +483,11 @@ tc_rec_sel_id lbl sel_name = do { thing <- tcLookup sel_name ; case thing of ATcId { tct_id = id } - -> do { check_naughty occ id -- Note [Local record selectors] - ; checkThLocalId id - ; tcEmitBindingUsage $ unitUE sel_name One + -> do { check_local_id occ id ; return id } AGlobal (AnId id) - -> do { check_naughty occ id + -> do { check_global_id occ id ; return id } -- A global cannot possibly be ill-staged -- nor does it need the 'lifting' treatment @@ -515,28 +498,44 @@ tc_rec_sel_id lbl sel_name where occ = rdrNameOcc (unLoc lbl) -check_naughty :: OccName -> TcId -> TcM () -check_naughty lbl id - | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl) - | otherwise = return () - ------------------------ +tcInferAmbiguousRecSelId :: Located RdrName + -> [HsExprArg 'TcpRn] -> Maybe TcRhoType + -> TcM Name +-- Disgusting special case for ambiguous record selectors -- Given a RdrName that refers to multiple record fields, and the type -- of its argument, try to determine the name of the selector that is -- meant. -- See Note [Disambiguating record fields] -disambiguateSelector :: Located RdrName -> Type -> TcM Name -disambiguateSelector lr@(L _ rdr) parent_type +tcInferAmbiguousRecSelId lbl args mb_res_ty + | arg1 : _ <- dropWhile (not . isVisibleArg) args -- A value arg is first + , EValArg { eva_arg = ValArg (L _ arg) } <- arg1 + , Just sig_ty <- obviousSig arg -- A type sig on the arg disambiguates + = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty + ; finish_ambiguous_selector lbl sig_tc_ty } + + | Just res_ty <- mb_res_ty + , Just (arg_ty,_) <- tcSplitFunTy_maybe res_ty + = finish_ambiguous_selector lbl (scaledThing arg_ty) + + | otherwise + = ambiguousSelector lbl + +finish_ambiguous_selector :: Located RdrName -> Type -> TcM Name +finish_ambiguous_selector lr@(L _ rdr) parent_type = do { fam_inst_envs <- tcGetFamInstEnvs - ; case tyConOf fam_inst_envs parent_type of - Nothing -> ambiguousSelector lr + ; case tyConOf fam_inst_envs parent_type of { + Nothing -> ambiguousSelector lr ; Just p -> - do { xs <- lookupParents rdr - ; let parent = RecSelData p - ; case lookup parent xs of - Just gre -> do { addUsedGRE True gre - ; return (gre_name gre) } - Nothing -> failWithTc (fieldNotInType parent rdr) } } + + do { xs <- lookupParents rdr + ; let parent = RecSelData p + ; case lookup parent xs of { + Nothing -> failWithTc (fieldNotInType parent rdr) ; + Just gre -> + + do { addUsedGRE True gre + ; return (gre_name gre) } } } } } -- This field name really is ambiguous, so add a suitable "ambiguous -- occurrence" error, then give up. @@ -608,6 +607,101 @@ naughtyRecordSel lbl text "Probable fix: use pattern-matching syntax instead" +{- ********************************************************************* +* * + Expressions with a type signature + expr :: type +* * +********************************************************************* -} + +tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn) + -> TcM (HsExpr GhcTc, TcSigmaType) +tcExprWithSig expr hs_ty + = do { sig_info <- checkNoErrs $ -- Avoid error cascade + tcUserTypeSig loc hs_ty Nothing + ; (expr', poly_ty) <- tcExprSig expr sig_info + ; return (ExprWithTySig noExtField expr' hs_ty, poly_ty) } + where + loc = getLoc (hsSigWcType hs_ty) + +tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType) +tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc }) + = setSrcSpan loc $ -- Sets the location for the implication constraint + do { let poly_ty = idType poly_id + ; (wrap, expr') <- tcSkolemiseScoped ExprSigCtxt poly_ty $ \rho_ty -> + tcCheckMonoExprNC expr rho_ty + ; return (mkLHsWrap wrap expr', poly_ty) } + +tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) + = setSrcSpan loc $ -- Sets the location for the implication constraint + do { (tclvl, wanted, (expr', sig_inst)) + <- pushLevelAndCaptureConstraints $ + do { sig_inst <- tcInstSig sig + ; expr' <- tcExtendNameTyVarEnv (mapSnd binderVar $ sig_inst_skols sig_inst) $ + tcExtendNameTyVarEnv (sig_inst_wcs sig_inst) $ + tcCheckPolyExprNC expr (sig_inst_tau sig_inst) + ; return (expr', sig_inst) } + -- See Note [Partial expression signatures] + ; let tau = sig_inst_tau sig_inst + infer_mode | null (sig_inst_theta sig_inst) + , isNothing (sig_inst_wcx sig_inst) + = ApplyMR + | otherwise + = NoRestrictions + ; (qtvs, givens, ev_binds, residual, _) + <- simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted + ; emitConstraints residual + + ; tau <- zonkTcType tau + ; let inferred_theta = map evVarPred givens + tau_tvs = tyCoVarsOfType tau + ; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta + tau_tvs qtvs (Just sig_inst) + ; let inferred_sigma = mkInfSigmaTy qtvs inferred_theta tau + my_sigma = mkInvisForAllTys binders (mkPhiTy my_theta tau) + ; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis. + then return idHsWrapper -- Fast path; also avoids complaint when we infer + -- an ambiguous type and have AllowAmbiguousType + -- e..g infer x :: forall a. F a -> Int + else tcSubTypeSigma ExprSigCtxt inferred_sigma my_sigma + + ; traceTc "tcExpSig" (ppr qtvs $$ ppr givens $$ ppr inferred_sigma $$ ppr my_sigma) + ; let poly_wrap = wrap + <.> mkWpTyLams qtvs + <.> mkWpLams givens + <.> mkWpLet ev_binds + ; return (mkLHsWrap poly_wrap expr', my_sigma) } + + +{- Note [Partial expression signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Partial type signatures on expressions are easy to get wrong. But +here is a guiding principile + e :: ty +should behave like + let x :: ty + x = e + in x + +So for partial signatures we apply the MR if no context is given. So + e :: IO _ apply the MR + e :: _ => IO _ do not apply the MR +just like in GHC.Tc.Gen.Bind.decideGeneralisationPlan + +This makes a difference (#11670): + peek :: Ptr a -> IO CLong + peek ptr = peekElemOff undefined 0 :: _ +from (peekElemOff undefined 0) we get + type: IO w + constraints: Storable w + +We must NOT try to generalise over 'w' because the signature specifies +no constraints so we'll complain about not being able to solve +Storable w. Instead, don't generalise; then _ gets instantiated to +CLong, as it should. +-} + + {- ********************************************************************* * * tcInferId, tcCheckId @@ -653,19 +747,12 @@ tc_infer_id id_name = do { thing <- tcLookup id_name ; case thing of ATcId { tct_id = id } - -> do { check_naughty occ id - -- See Note [HsVar: naughty record selectors] - ; checkThLocalId id - ; tcEmitBindingUsage $ unitUE id_name One + -> do { check_local_id occ id ; return_id id } AGlobal (AnId id) - -> do { check_naughty occ id - -- See Note [HsVar: naughty record selectors] + -> do { check_global_id occ id ; return_id id } - -- A global cannot possibly be ill-staged - -- nor does it need the 'lifting' treatment - -- hence no checkTh stuff here AGlobal (AConLike cl) -> case cl of RealDataCon con -> return_data_con con @@ -725,6 +812,23 @@ tc_infer_id id_name , mkInvisForAllTys tvs $ mkInvisFunTysMany theta $ mkVisFunTys scaled_arg_tys res) } +check_local_id :: OccName -> Id -> TcM () +check_local_id occ id + = do { check_naughty occ id -- See Note [HsVar: naughty record selectors] + ; checkThLocalId id + ; tcEmitBindingUsage $ unitUE (idName id) One } + +check_global_id :: OccName -> Id -> TcM () +check_global_id occ id + = check_naughty occ id -- See Note [HsVar: naughty record selectors] + -- A global cannot possibly be ill-staged + -- nor does it need the 'lifting' treatment + -- Hence no checkTh stuff here + +check_naughty :: OccName -> TcId -> TcM () +check_naughty lbl id + | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl) + | otherwise = return () nonBidirectionalErr :: Outputable name => name -> TcM a nonBidirectionalErr name = failWithTc $ ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -267,11 +267,10 @@ kind-generalisation, is done by kindGeneraliseSome kindGeneraliseNone -perform kind generalisation. Here, we have to deal with the fact that -metatyvars generated in the type will have a bumped TcLevel, because -explicit foralls raise the TcLevel. To avoid these variables from ever -being visible in the surrounding context, we must obey the following -dictum: +Here, we have to deal with the fact that metatyvars generated in the +type will have a bumped TcLevel, because explicit foralls raise the +TcLevel. To avoid these variables from ever being visible in the +surrounding context, we must obey the following dictum: Every metavariable in a type must either be (A) generalized, or @@ -1057,7 +1056,7 @@ tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind = do { (tclvl, wanted, (tv_bndrs, ty')) <- pushLevelAndCaptureConstraints $ -- No need to solve equalities here; we will do that later - bindExplicitTKTele mode tele $ + bindExplicitTKTele_Skol_M mode tele $ -- The _M variant passes on the mode from the type, to -- any wildards in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah @@ -3024,12 +3023,12 @@ cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar -------------------------------------- -- | Skolemise the 'HsTyVarBndr's in an 'LHsForAllTelescope. -bindExplicitTKTele +bindExplicitTKTele_Skol_M :: TcTyMode -> HsForAllTelescope GhcRn -> TcM a -> TcM ([TcTyVarBinder], a) -bindExplicitTKTele mode tele thing_inside = case tele of +bindExplicitTKTele_Skol_M mode tele thing_inside = case tele of HsForAllVis { hsf_vis_bndrs = bndrs } -> do { (req_tv_bndrs, thing) <- bindExplicitTKBndrs_Skol_M mode bndrs thing_inside -- req_tv_bndrs :: [VarBndr TyVar ()], ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2631,7 +2631,7 @@ https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0179-printi re-generalising, as discussed in #11376. > :type reverse - reverse :: forall a. a -> a + reverse :: forall a. [a] -> [a] -- foo :: forall a f b. (Show a, Num b, Foldable f) => a -> f b -> String > :type +v foo @Int ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -159,6 +159,8 @@ simplifyTop wanteds pushLevelAndSolveEqualities :: SkolemInfo -> [TcTyVar] -> TcM a -> TcM a -- Push level, and solve all resulting equalities +-- If there are any unsolved equalities, report them +-- and fail (in the monad) pushLevelAndSolveEqualities skol_info skol_tvs thing_inside = do { (tclvl, wanted, res) <- pushLevelAndSolveEqualitiesX "pushLevelAndSolveEqualities" thing_inside @@ -167,6 +169,9 @@ pushLevelAndSolveEqualities skol_info skol_tvs thing_inside pushLevelAndSolveEqualitiesX :: String -> TcM a -> TcM (TcLevel, WantedConstraints, a) +-- Push the level, gather equality constraints, and then solve them. +-- Returns any remaining unsolved equalities. +-- Does not report errors. pushLevelAndSolveEqualitiesX callsite thing_inside = do { traceTc "pushLevelAndSolveEqualitiesX {" (text "Called from" <+> text callsite) ; (tclvl, (wanted, res)) @@ -180,7 +185,7 @@ pushLevelAndSolveEqualitiesX callsite thing_inside -- | Type-check a thing that emits only equality constraints, solving any -- constraints we can and re-emitting constraints that we can't. --- We'll get another crack at it later +-- Use this variant only when we'll get another crack at it later -- See Note [Failure in local type signatures] solveEqualities :: String -> TcM a -> TcM a solveEqualities callsite thing_inside @@ -347,6 +352,9 @@ See also #18062, #11506 reportUnsolvedEqualities :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM () +-- Reports all unsolved wanteds provided; fails in the monad if there are any. +-- The provided SkolemInfo and [TcTyVar] arguments are used in an implication to +-- provide skolem info for any errors. reportUnsolvedEqualities skol_info skol_tvs tclvl wanted | isEmptyWC wanted = return () @@ -2370,7 +2378,7 @@ beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: h :: F Int -> () h = undefined -o data TEx where + data TEx where TEx :: a -> TEx f (x::beta) = ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -58,6 +58,7 @@ import GHC.Core.Class import GHC.Core.Coercion.Axiom import GHC.Core.TyCon import GHC.Core.DataCon +import GHC.Hs.Decls( newOrDataToFlavour ) import GHC.Types.Id import GHC.Types.Var import GHC.Types.Var.Env @@ -2317,7 +2318,7 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs ; return (ctxt, fds, sig_stuff, at_stuff) } - -- The reportUnsolvedEqualities will report errors for any + -- The pushLevelAndSolveEqualities will report errors for any -- unsolved equalities, so these zonks should not encounter -- any unfilled coercion variables unless there is such an error -- The zonk also squeeze out the TcTyCons, and converts @@ -2795,8 +2796,7 @@ tcDataDefn err_ctxt roles_info tc_name ; return (tycon, [deriv_info]) } where skol_info = TyConSkol flav tc_name - flav = case new_or_data of { NewType -> NewtypeFlavour - ; DataType -> DataTypeFlavour } + flav = newOrDataToFlavour new_or_data -- Abstract data types in hsig files can have arbitrary kinds, -- because they may be implemented by type synonyms @@ -3305,12 +3305,12 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; let skol_tvs = imp_tvs ++ binderVars exp_tvbndrs ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - ; let fake_ty = mkSpecForAllTys imp_tvs $ - mkInvisForAllTys exp_tvbndrs $ - mkPhiTy ctxt $ - mkVisFunTys arg_tys $ - res_ty - ; tkvs <- kindGeneralizeAll fake_ty + ; let con_ty = mkSpecForAllTys imp_tvs $ + mkInvisForAllTys exp_tvbndrs $ + mkPhiTy ctxt $ + mkVisFunTys arg_tys $ + res_ty + ; tkvs <- kindGeneralizeAll con_ty ; let tvbndrs = mkTyVarBinders InferredSpec tkvs ++ mkTyVarBinders SpecifiedSpec imp_tvs ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -969,6 +969,8 @@ addHoles wc holes dropMisleading :: WantedConstraints -> WantedConstraints -- Drop misleading constraints; really just class constraints -- See Note [Constraints and errors] in GHC.Tc.Utils.Monad +-- for why this function is so strange, treating the 'simples' +-- and the implications differently. Sigh. dropMisleading (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes }) = WC { wc_simple = filterBag insolubleCt simples , wc_impl = mapBag drop_implic implics ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -468,7 +468,7 @@ readExpType exp_ty -- | Returns the expected type when in checking mode. checkingExpType_maybe :: ExpType -> Maybe TcType checkingExpType_maybe (Check ty) = Just ty -checkingExpType_maybe _ = Nothing +checkingExpType_maybe (Infer {}) = Nothing -- | Returns the expected type when in checking mode. Panics if in inference -- mode. @@ -1646,11 +1646,11 @@ alpha[1] and beta[2]? Their levels. beta[2] has the right TcLevel for generalisation, and so we generalise it. alpha[1] does not, and so we leave it alone. -Note that not *every* variable with a higher level will get generalised, -either due to the monomorphism restriction or other quirks. See, for -example, the code in GHC.Tc.Solver.decideMonoTyVars and in -GHC.Tc.Gen.HsType.kindGeneralize, both of which exclude certain otherwise-eligible -variables from being generalised. +Note that not *every* variable with a higher level will get +generalised, either due to the monomorphism restriction or other +quirks. See, for example, the code in GHC.Tc.Solver.decideMonoTyVars +and in GHC.Tc.Gen.HsType.kindGeneralizeSome, both of which exclude +certain otherwise-eligible variables from being generalised. Using level numbers for quantification is implemented in the candidateQTyVars... functions, by adding only those variables with a level strictly higher than @@ -1690,7 +1690,7 @@ quantifyTyVars dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) | otherwise = do { traceTc "quantifyTyVars {" (ppr dvs) - ; let !(dep_kvs, nondep_tvs) = candidateKiTyVars dvs + ; let (dep_kvs, nondep_tvs) = candidateKiTyVars dvs -- In the non-PolyKinds case, default the kind variables -- to *, and zonk the tyvars as usual. Notice that this ===================================== docs/users_guide/exts/impredicative_types.rst ===================================== @@ -25,7 +25,7 @@ instantiate ``id``\'s type with ``b := (forall s. ST s a) -> a``, and that is not allowed. Instantiating polymorphic type variables with polymorphic types is called *impredicative polymorphism*. -GHC has robut support for *impredicative polymorphism*, +GHC has robust support for *impredicative polymorphism*, enabled with :extension:`ImpredicativeTypes`, using the so-called Quick Look inference algorithm. It is described in the paper `A quick look at impredicativity @@ -38,7 +38,7 @@ Switching on :extension:`ImpredicativeTypes` For example ``f :: Maybe (forall a. [a] -> [a])`` is a legal type signature. - Switches on the Quick Look type inference algorithm, as described - in the paper. The allow the compiler to infer impredicative instantiations of polymorphic + in the paper. This allows the compiler to infer impredicative instantiations of polymorphic functions in many cases. For example, ``reverse xs`` will typecheck even if ``xs :: [forall a. a->a]``, by instantiating ``reverse`` at type ``forall a. a->a``. ===================================== docs/users_guide/ghci.rst ===================================== @@ -2975,11 +2975,6 @@ commonly used commands. *X> :type length length :: Foldable t => t a -> Int -.. ghci-cmd:: :type +v; ⟨expression⟩ - - Infers and prints the type of ⟨expression⟩, binding inferred type variables - with :ref:`*specified* visibility `. - .. ghci-cmd:: :type +d; ⟨expression⟩ Infers and prints the type of ⟨expression⟩, instantiating *all* the forall ===================================== testsuite/tests/impredicative/all.T ===================================== @@ -19,3 +19,4 @@ test('T9730', normal, compile, ['']) test('T7026', normal, compile, ['']) test('T8808', normal, compile, ['']) test('T17332', normal, compile_fail, ['']) +test('expr-sig', normal, compile, ['']) ===================================== testsuite/tests/impredicative/expr-sig.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE ImpredicativeTypes, RankNTypes #-} + +module ExprSig where + +import Data.Kind + +f :: [forall a. a->a] -> Int +f x = error "urk" + +g1 = f undefined + +-- This should be accepted (and wasn't) +g2 = f (undefined :: forall b. b) + +f3 :: [forall a. a->a] -> b +f3 x = error "urk" + +g3 = f3 (undefined :: forall b. b) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6ee690e7828d95e174c422ac13df70a1d25e27a...4c56d0afda9fe4741fc3aaf2539cd3d6ba87eb00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6ee690e7828d95e174c422ac13df70a1d25e27a...4c56d0afda9fe4741fc3aaf2539cd3d6ba87eb00 You're receiving 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 14 12:38:15 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Sep 2020 08:38:15 -0400 Subject: [Git][ghc/ghc][wip/T18126] 3 commits: Implement Quick Look impredicativity Message-ID: <5f5f6437dbb07_80b3f8468f3af0811902310@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 70721a6b by Simon Peyton Jones at 2020-09-14T13:37:43+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 94d7e377 by Simon Peyton Jones at 2020-09-14T13:37:43+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 - - - - - 126c219a by GHC GitLab CI at 2020-09-14T13:37:43+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/4c56d0afda9fe4741fc3aaf2539cd3d6ba87eb00...126c219a502d2565d4d381a70ee3f464bce73a94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c56d0afda9fe4741fc3aaf2539cd3d6ba87eb00...126c219a502d2565d4d381a70ee3f464bce73a94 You're receiving 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 14 13:16:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 14 Sep 2020 09:16:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Avoid iterating twice in `zipTyEnv` (#18535) Message-ID: <5f5f6d1f8b292_80b3f84922bd2d81192063f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 73de2627 by Adam Sandberg Eriksson at 2020-09-14T09:16:02-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - ad3dcbe3 by Wander Hillen at 2020-09-14T09:16:04-04:00 Populate gitlab cache after building - - - - - 59cca4af by Wander Hillen at 2020-09-14T09:16:04-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - 36b2e7b7 by Wander Hillen at 2020-09-14T09:16:04-04:00 Do the hadrian rebuild multicore - - - - - dda2198a by Wander Hillen at 2020-09-14T09:16:04-04:00 Also cache other hadrian builds - - - - - 20 changed files: - .gitlab-ci.yml - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Unique/FM.hs - compiler/ghc.cabal.in - docs/users_guide/runtime_control.rst - + 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: ===================================== .gitlab-ci.yml ===================================== @@ -229,6 +229,7 @@ lint-release-changelogs: - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" after_script: + - cp -Rf $HOME/.cabal cabal-cache - .gitlab/ci.sh clean tags: - x86_64-linux @@ -258,15 +259,16 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - .gitlab/ci.sh setup - cabal update - - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. + - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --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 - ./boot - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," + after_script: + - cp -Rf $HOME/.cabal cabal-cache cache: key: hadrian-ghci paths: ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -440,7 +440,7 @@ zipTyEnv tyvars tys = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) | otherwise = ASSERT( all (not . isCoercionTy) tys ) - mkVarEnv (zipEqual "zipTyEnv" tyvars tys) + zipToUFM tyvars tys -- There used to be a special case for when -- ty == TyVarTy tv -- (a not-uncommon case) in which case the substitution was dropped. ===================================== 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,7 +37,6 @@ 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.Data.Bag import GHC.Types.Name.Reader @@ -58,6 +58,7 @@ import GHC.Hs.Extension import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe +import qualified Data.Kind {- ************************************************************************ @@ -89,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/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/PmCheck/Oracle.hs ===================================== @@ -584,13 +584,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) @@ -597,15 +596,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/HsToCore/Types.hs ===================================== @@ -0,0 +1,85 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + +-- | 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 (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) + +{- +************************************************************************ +* * + 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 + +-- See Note [The Decoupling Abstract Data Hack] +type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) ===================================== 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/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 ===================================== 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/Types/Unique/FM.hs ===================================== @@ -23,6 +23,7 @@ of arguments of combining function. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.FM ( @@ -34,6 +35,7 @@ module GHC.Types.Unique.FM ( emptyUFM, unitUFM, unitDirectlyUFM, + zipToUFM, listToUFM, listToUFM_Directly, listToUFM_C, @@ -75,11 +77,14 @@ module GHC.Types.Unique.FM ( pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM ) where +#include "HsVersions.h" + import GHC.Prelude import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) import GHC.Utils.Outputable - +import GHC.Utils.Panic (assertPanic) +import GHC.Utils.Misc (debugIsOn) import qualified Data.IntMap as M import qualified Data.IntSet as S import Data.Data @@ -113,6 +118,19 @@ unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v) unitDirectlyUFM :: Unique -> elt -> UniqFM key elt unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) +-- zipToUFM ks vs = listToUFM (zip ks vs) +-- This function exists because it's a common case (#18535), and +-- it's inefficient to first build a list of pairs, and then immediately +-- take it apart. Astonishingly, fusing this one list away reduces total +-- compiler allocation by more than 10% (in T12545, see !3935) +-- Note that listToUFM (zip ks vs) performs similarly, but +-- the explicit recursion avoids relying too much on fusion. +zipToUFM :: Uniquable key => [key] -> [elt] -> UniqFM key elt +zipToUFM ks vs = ASSERT( length ks == length vs ) innerZip emptyUFM ks vs + where + innerZip ufm (k:kList) (v:vList) = innerZip (addToUFM ufm k v) kList vList + innerZip ufm _ _ = ufm + listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM ===================================== compiler/ghc.cabal.in ===================================== @@ -314,6 +314,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1253,7 +1253,7 @@ recommended for everyday use! .. rts-flag:: -B - Sound the bell at the start of each (major) garbage collection. + Sound the bell at the start of each garbage collection. Oddly enough, people really do use this option! Our pal in Durham (England), Paul Callaghan, writes: “Some people here use it for a ===================================== 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/-/compare/04270c3e75a1c586e2b301acca05775d138b9b7c...dda2198a16ee9abafbd56571c90603f87bef81cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04270c3e75a1c586e2b301acca05775d138b9b7c...dda2198a16ee9abafbd56571c90603f87bef81cf You're receiving 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 14 13:25:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 09:25:03 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f5f6f2fa7477_80b3f849574a898119235e5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 8000f515 by Ben Gamari at 2020-09-14T09:24:57-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,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; } ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8000f51593a56f17fe707001df06ccf565b90a00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8000f51593a56f17fe707001df06ccf565b90a00 You're receiving 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 14 13:30:59 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 14 Sep 2020 09:30:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18426 Message-ID: <5f5f7093dd86d_80b8bc93c01192393e@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18426 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18426 You're receiving 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 14 14:31:36 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 14 Sep 2020 10:31:36 -0400 Subject: [Git][ghc/ghc][wip/T18126] 2 commits: wibbles ql Message-ID: <5f5f7ec81871e_80b108a98f4119529b2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 7572a47e by Simon Peyton Jones at 2020-09-14T15:30:36+01:00 wibbles ql - - - - - 9f5ec175 by Simon Peyton Jones at 2020-09-14T15:31:00+01:00 wibbles generalisation patch - - - - - 5 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Utils/Unify.hs - docs/users_guide/ghci.rst Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Core.TyCon import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr import GHC.Core.TyCo.Subst (substTyWithInScope) +import GHC.Core.TyCo.FVs( shallowTyCoVarsOfType ) import GHC.Core.Type import GHC.Tc.Types.Evidence import GHC.Types.Var.Set @@ -852,31 +853,69 @@ qlUnify delta ty1 ty2 ; go_flexi bvs kappa ty2 } } ---------------- - -- ToDo: what about other magic in Unify.metaTyVarUpdateOK? go_flexi (_,bvs2) kappa ty2 -- ty2 is zonked - | ty2_tvs `intersectsVarSet` bvs2 -- We really only need shallow here - = return () -- Can't instantiate a delta-var - -- to a forall-bound variable - - | kappa `elemVarSet` ty2_tvs - = return () -- Occurs-check - - | otherwise - = do { -- Unify the kinds - -- c.f. Note [Equalities with incompatible kinds] in Solver.Canonical - ; co <- unifyKind (Just (ppr ty2)) ty2_kind kappa_kind + | -- See Note [Actual unification in qlUnify] + let ty2_tvs = shallowTyCoVarsOfType ty2 + , not (ty2_tvs `intersectsVarSet` bvs2) + -- Can't instantiate a delta-varto a forall-bound variable + , Just ty2' <- occCheckExpand [kappa] ty2 + -- Passes the occurs check + = do { co <- unifyKind (Just (ppr ty2)) ty2_kind kappa_kind + -- unifyKind: see Note [Actual unification in qlUnify] ; traceTc "qlUnify:update" $ vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind) 2 (text ":=" <+> ppr ty2 <+> dcolon <+> ppr ty2_kind) , text "co:" <+> ppr co ] ; writeMetaTyVar kappa (mkCastTy ty2 co) } + + | otherwise + = return () -- Occurs-check or forall-bound varialbe where - ty2_tvs = tyCoVarsOfType ty2 ty2_kind = typeKind ty2 kappa_kind = tyVarKind kappa +{- Note [Actual unification in qlUnify] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In qlUnify, if we find (kappa ~ ty), we are going to update kappa := ty. +That is the entire point of qlUnify! Wrinkles + +* We must not unify with anything bound by an enclosing forall; e.g. + (forall a. kappa -> Int) ~ forall a. a -> Int) + That's tracked by the 'bvs' arg of 'go'. + +* We must not make an occurs-check; we use occCheckExpand for that. + +* metaTyVarUpdateOK also checks for various other things, including + - foralls, and predicate types, which we want to allow here + - blocking coercion holes + - type families + But after some thought we believe that none of these are relevant + here. + +* What if kappa and ty have different kinds? We solve that problem by + calling unifyKind, producing a coercion perhaps emitting some deferred + equality constraints. That is /different/ from the approach we use in + the main constraint solver for herterogeneous equalities; see Note + [Equalities with incompatible kinds] in Solver.Canonical + + Why different? Because: + - We can't use qlUnify to solve the kind constraint because qlUnify + won't unify ordinary (non-instantiation) unification variables. + (It would have to worry about lots of things like untouchability + if it did.) + - qlUnify can't give up if the kinds look un-equal because that would + mean that it might succeed some times (when the eager unifier + has already unified those kinds) but not others -- order + dependence. + - We can't use the ordinary unifier/constraint solver instead, + because it doesn't unify polykinds, and has all kinds of other + magic. qlUnify is very focused. + + TL;DR Calling unifyKind seems like the lesser evil. + -} + {- ********************************************************************* * * Guardedness ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -161,6 +161,9 @@ pushLevelAndSolveEqualities :: SkolemInfo -> [TcTyVar] -> TcM a -> TcM a -- Push level, and solve all resulting equalities -- If there are any unsolved equalities, report them -- and fail (in the monad) +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) pushLevelAndSolveEqualities skol_info skol_tvs thing_inside = do { (tclvl, wanted, res) <- pushLevelAndSolveEqualitiesX "pushLevelAndSolveEqualities" thing_inside @@ -172,6 +175,9 @@ pushLevelAndSolveEqualitiesX :: String -> TcM a -- Push the level, gather equality constraints, and then solve them. -- Returns any remaining unsolved equalities. -- Does not report errors. +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) pushLevelAndSolveEqualitiesX callsite thing_inside = do { traceTc "pushLevelAndSolveEqualitiesX {" (text "Called from" <+> text callsite) ; (tclvl, (wanted, res)) @@ -187,6 +193,9 @@ pushLevelAndSolveEqualitiesX callsite thing_inside -- constraints we can and re-emitting constraints that we can't. -- Use this variant only when we'll get another crack at it later -- See Note [Failure in local type signatures] +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) solveEqualities :: String -> TcM a -> TcM a solveEqualities callsite thing_inside = do { traceTc "solveEqualities {" (text "Called from" <+> text callsite) ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -2144,7 +2144,7 @@ k2 and use this to cast. To wit, from [X] (tv :: k1) ~ (rhs :: k2) -we go to +(where [X] is [G], [W], or [D]), we go to [noDerived X] co :: k2 ~ k1 [X] (tv :: k1) ~ ((rhs |> co) :: k1) @@ -2154,6 +2154,9 @@ where noDerived G = G noDerived _ = W +For Wanted/Derived, the [X] constraint is "blocked" (not CTyEqCan, is CIrred) +until the k1~k2 constraint solved: Wrinkle (2). + Wrinkles: (1) The noDerived step is because Derived equalities have no evidence. @@ -2166,7 +2169,7 @@ Wrinkles: [W] (tv :: k1) ~ ((rhs |> co) :: k1) as canonical in the inert set. In particular, we must not unify tv. If we did, the Wanted becomes a Given (effectively), and then can - rewrite other Wanteds. But that's bad: See Note [Wanteds to not rewrite Wanteds] + rewrite other Wanteds. But that's bad: See Note [Wanteds do not rewrite Wanteds] in GHC.Tc.Types.Constraint. The problem is about poor error messages. See #11198 for tales of destruction. ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Tc.Utils.Unify ( -- Full-blown subsumption tcWrapResult, tcWrapResultO, tcWrapResultMono, - tcSkolemise, tcSkolemiseScoped, tcSkolemiseAlways, tcSkolemiseET, + tcSkolemise, tcSkolemiseScoped, tcSkolemiseET, tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubMult, checkConstraints, checkTvConstraints, @@ -93,6 +93,9 @@ matchActualFunTySigma -- Both are used only for error messages) -> TcRhoType -- Type to analyse: a TcRhoType -> TcM (HsWrapper, Scaled TcSigmaType, TcSigmaType) +-- The /argument/ is a RhoType +-- The /result/ is an (uninstantiated) SigmaType +-- -- See Note [matchActualFunTy error handling] for the first three arguments -- If (wrap, arg_ty, res_ty) = matchActualFunTySigma ... fun_ty @@ -826,10 +829,11 @@ to checkConstraints. tcSkolemiseScoped is very similar, but differs in two ways: -* It deals specially with just the outer forall, bringing those - type variables into lexical scope. To my surprise, I found that - doing this regardless (in tcSkolemise) caused a non-trivial (1%-ish) - perf hit on the compiler. +* It deals specially with just the outer forall, bringing those type + variables into lexical scope. To my surprise, I found that doing + this unconditionally in tcSkolemise (i.e. doing it even if we don't + need to bring the variables into lexical scope, which is harmless) + caused a non-trivial (1%-ish) perf hit on the compiler. * It always calls checkConstraints, even if there are no skolem variables at all. Reason: there might be nested deferred errors @@ -837,11 +841,13 @@ tcSkolemiseScoped is very similar, but differs in two ways: See Note [When to build an implication] below. -} -tcSkolemise, tcSkolemiseScoped, tcSkolemiseAlways +tcSkolemise, tcSkolemiseScoped :: UserTypeCtxt -> TcSigmaType -> (TcType -> TcM result) -> TcM (HsWrapper, result) -- ^ The wrapper has type: spec_ty ~> expected_ty +-- See Note [Skolemisation] for the differences between +-- tcSkolemiseScoped and tcSkolemise tcSkolemiseScoped ctxt expected_ty thing_inside = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty @@ -860,9 +866,6 @@ tcSkolemise ctxt expected_ty thing_inside = do { res <- thing_inside expected_ty ; return (idHsWrapper, res) } | otherwise - = tcSkolemiseAlways ctxt expected_ty thing_inside - -tcSkolemiseAlways ctxt expected_ty thing_inside = do { (wrap, tv_prs, given, rho_ty) <- topSkolemise expected_ty ; let skol_tvs = map snd tv_prs @@ -1946,7 +1949,7 @@ occCheckForErrors :: DynFlags -> TcTyVar -> Type -> MetaTyVarUpdateResult () -- a) the given variable occurs in the given type. -- b) there is a forall in the type (unless we have -XImpredicativeTypes) occCheckForErrors dflags tv ty - = case preCheck dflags True tv ty of + = case mtvu_check dflags True tv ty of MTVU_OK _ -> MTVU_OK () MTVU_Bad -> MTVU_Bad MTVU_HoleBlocker -> MTVU_HoleBlocker @@ -1960,13 +1963,20 @@ metaTyVarUpdateOK :: DynFlags -> TcType -- ty :: k2 -> MetaTyVarUpdateResult TcType -- possibly-expanded ty -- (metaTyVarUpdateOK tv ty) --- We are about to update the meta-tyvar tv with ty --- Check (a) that tv doesn't occur in ty (occurs check) +-- Checks that the equality tv~ty is OK to be used to rewrite +-- other equalities. Equivalently, checks the conditions for CTyEqCan +-- (a) that tv doesn't occur in ty (occurs check) -- (b) that ty does not have any foralls -- (in the impredicative case), or type functions -- (c) that ty does not have any blocking coercion holes -- See Note [Equalities with incompatible kinds] in "GHC.Tc.Solver.Canonical" -- +-- Used in two places: +-- - In the eager unifier: uUnfilledVar2 +-- - In the canonicaliser: GHC.Tc.Solver.Canonical.canEqTyVar2 +-- Note that in the latter case tv is not necessarily a meta-tyvar, +-- despite the name of this function. + -- We have two possible outcomes: -- (1) Return the type to update the type variable with, -- [we know the update is ok] @@ -1985,7 +1995,7 @@ metaTyVarUpdateOK :: DynFlags -- See Note [Refactoring hazard: checkTauTvUpdate] metaTyVarUpdateOK dflags tv ty - = case preCheck dflags False tv ty of + = case mtvu_check dflags False tv ty of -- False <=> type families not ok -- See Note [Prevent unification with type families] MTVU_OK _ -> MTVU_OK ty @@ -1995,8 +2005,8 @@ metaTyVarUpdateOK dflags tv ty Just expanded_ty -> MTVU_OK expanded_ty Nothing -> MTVU_Occurs -preCheck :: DynFlags -> Bool -> TcTyVar -> TcType -> MetaTyVarUpdateResult () --- A quick check for +mtvu_check :: DynFlags -> Bool -> TcTyVar -> TcType -> MetaTyVarUpdateResult () +-- Checks the invariants for CTyEqCan. In particular: -- (a) a forall type (forall a. blah) -- (b) a predicate type (c => ty) -- (c) a type family; see Note [Prevent unification with type families] @@ -2007,7 +2017,7 @@ preCheck :: DynFlags -> Bool -> TcTyVar -> TcType -> MetaTyVarUpdateResult () -- inside the kinds of variables it mentions. For (d) we look deeply -- in coercions, and for (e) we do look in the kinds of course. -preCheck dflags ty_fam_ok tv ty +mtvu_check dflags ty_fam_ok tv ty = fast_check ty where ok :: MetaTyVarUpdateResult () ===================================== docs/users_guide/ghci.rst ===================================== @@ -2968,7 +2968,7 @@ commonly used commands. Infers and prints the type of ⟨expression⟩. For polymorphic types it instantiates the 'inferred' forall quantifiers (but not the - 'specified' ones), solves constraints, and re-generalises. + 'specified' ones; see :ref:`inferred-vs-specified`), solves constraints, and re-generalises. .. code-block:: none View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/126c219a502d2565d4d381a70ee3f464bce73a94...9f5ec17529213e447e708622289f2c32bb6b0739 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/126c219a502d2565d4d381a70ee3f464bce73a94...9f5ec17529213e447e708622289f2c32bb6b0739 You're receiving 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 14 14:42:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 10:42:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18658 Message-ID: <5f5f814c3061c_80b108a98f411965030@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T18658 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18658 You're receiving 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 14 15:41:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 11:41:57 -0400 Subject: [Git][ghc/ghc][wip/T18126] 115 commits: Implement -Wredundant-bang-patterns (#17340) Message-ID: <5f5f8f451660f_80b3f8486497830119861f7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - f985681c by Simon Peyton Jones at 2020-09-14T11:41:17-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - c2214738 by Simon Peyton Jones at 2020-09-14T11:41:21-04: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 - - - - - ed2f494c by Simon Peyton Jones at 2020-09-14T11:41:37-04:00 wibbles ql - - - - - 92e20da3 by Simon Peyton Jones at 2020-09-14T11:41:37-04:00 wibbles generalisation patch - - - - - 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/Cmm/CLabel.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/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f5ec17529213e447e708622289f2c32bb6b0739...92e20da38f8a802470f6f172835c214ec78e7216 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f5ec17529213e447e708622289f2c32bb6b0739...92e20da38f8a802470f6f172835c214ec78e7216 You're receiving 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 14 16:41:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 12:41:14 -0400 Subject: [Git][ghc/ghc][wip/T18126] 5 commits: Implement Quick Look impredicativity Message-ID: <5f5f9d2adc9ff_80b3f83f2c92100120142cc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 2351f490 by Simon Peyton Jones at 2020-09-14T12:41:08-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - d297b1b5 by Simon Peyton Jones at 2020-09-14T12:41:09-04: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 - - - - - 6dd91ef1 by Simon Peyton Jones at 2020-09-14T12:41:09-04:00 wibbles ql - - - - - fda9dc7f by Simon Peyton Jones at 2020-09-14T12:41:09-04:00 wibbles generalisation patch - - - - - d2a6cc9a by Ben Gamari at 2020-09-14T12:41:09-04:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 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/92e20da38f8a802470f6f172835c214ec78e7216...d2a6cc9a067d7570221e319e523b11de969287ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92e20da38f8a802470f6f172835c214ec78e7216...d2a6cc9a067d7570221e319e523b11de969287ac You're receiving 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 14 18:02:41 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 14:02:41 -0400 Subject: [Git][ghc/ghc][wip/T18126] Silence unused binder warning Message-ID: <5f5fb0411a7bb_80b3f84778a2330120362e0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: b9c66bd3 by Ben Gamari at 2020-09-14T14:00:49-04:00 Silence unused binder warning It looks to me like the intent here is merely to invoke the occurrence check and that we do not need the expanded type. - - - - - 1 changed file: - compiler/GHC/Tc/Gen/App.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -858,7 +858,7 @@ qlUnify delta ty1 ty2 let ty2_tvs = shallowTyCoVarsOfType ty2 , not (ty2_tvs `intersectsVarSet` bvs2) -- Can't instantiate a delta-varto a forall-bound variable - , Just ty2' <- occCheckExpand [kappa] ty2 + , Just _ty2' <- occCheckExpand [kappa] ty2 -- Passes the occurs check = do { co <- unifyKind (Just (ppr ty2)) ty2_kind kappa_kind -- unifyKind: see Note [Actual unification in qlUnify] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9c66bd345539ebf828819a538b03171128408d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9c66bd345539ebf828819a538b03171128408d0 You're receiving 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 14 18:05:22 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 14:05:22 -0400 Subject: [Git][ghc/ghc][ghc-8.10] rts linker: teach the linker about GLIBC's special handling of *stat, mknod... Message-ID: <5f5fb0e2d0bda_80bf2b18bc1204247@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC Commits: 721dc35d by Adam Sandberg Ericsson at 2020-09-12T10:19:57+01:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 (cherry picked from commit 0effc57d48ace6b719a9f4cbeac67c95ad55010b) - - - - - 6 changed files: - rts/Linker.c - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T7072-main.c - + testsuite/tests/rts/linker/T7072-obj.c - + testsuite/tests/rts/linker/T7072.stderr - testsuite/tests/rts/linker/all.T Changes: ===================================== rts/Linker.c ===================================== @@ -655,23 +655,51 @@ internal_dlsym(const char *symbol) { // We acquire dl_mutex as concurrent dl* calls may alter dlerror ACQUIRE_LOCK(&dl_mutex); + + // clears dlerror dlerror(); + // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { v = dlsym(o_so->handle, symbol); if (dlerror() == NULL) { + IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); RELEASE_LOCK(&dl_mutex); return v; } } RELEASE_LOCK(&dl_mutex); - return v; + +# if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) + // HACK: GLIBC implements these functions with a great deal of trickery where + // they are either inlined at compile time to their corresponding + // __xxxx(SYS_VER, ...) function or direct syscalls, or resolved at + // link time via libc_nonshared.a. + // + // We borrow the approach that the LLVM JIT uses to resolve these + // symbols. See http://llvm.org/PR274 and #7072 for more info. + + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + + if (strcmp(symbol, "stat") == 0) return (void*)&stat; + if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; + if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; + if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; + if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; + if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; + if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; + if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; +# endif + + // we failed to find the symbol + return NULL; } # endif @@ -847,13 +875,13 @@ SymbolAddr* lookupSymbol_ (SymbolName* lbl) SymbolAddr* lookupSymbol_ (SymbolName* lbl) { - IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up '%s'\n", lbl)); ASSERT(symhash != NULL); RtsSymbolInfo *pinfo; if (!ghciLookupSymbolInfo(symhash, lbl, &pinfo)) { - IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol '%s' not found, trying dlsym\n", lbl)); # if defined(OBJFORMAT_ELF) return internal_dlsym(lbl); ===================================== testsuite/tests/rts/linker/Makefile ===================================== @@ -96,3 +96,10 @@ linker_error3: "$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o "$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded ./linker_error3 linker_error3_o.o + +.PHONY: T7072 +T7072: + "$(TEST_HC)" -c T7072-obj.c -o T7072-obj.o + "$(TEST_HC)" -c T7072-main.c -o T7072-main.o + "$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug + ./T7072-main T7072-obj.o ===================================== testsuite/tests/rts/linker/T7072-main.c ===================================== @@ -0,0 +1,39 @@ +#include "ghcconfig.h" +#include "Rts.h" +#include +#include + +int main (int argc, char *argv[]) +{ + int r; + char *obj; + + hs_init(&argc, &argv); + + initLinker_(0); + + // Load object file argv[1] repeatedly + + if (argc != 2) { + errorBelch("usage: T7072-main "); + exit(1); + } + + obj = argv[1]; + + r = loadObj(obj); + if (!r) { + debugBelch("loadObj(%s) failed\n", obj); + exit(1); + } + r = resolveObjs(); + if (!r) { + debugBelch("resolveObjs failed\n"); + unloadObj(obj); + exit(1); + } + debugBelch("loading succeeded"); + + hs_exit(); + return 0; +} ===================================== testsuite/tests/rts/linker/T7072-obj.c ===================================== @@ -0,0 +1,17 @@ +#include +#include +#include +#include + +typedef int stat_func(const char*, struct stat*); + +stat_func *foo = &stat; + +void stat_test(void) +{ + struct stat buf; + + printf("About to stat-test.c\n"); + foo("stat-test.c", &buf); + printf("Done\n"); +} ===================================== testsuite/tests/rts/linker/T7072.stderr ===================================== @@ -0,0 +1 @@ +loading succeeded \ No newline at end of file ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -92,3 +92,10 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) , omit_ways(['ghci']) ], compile_and_run, ['-rdynamic -package ghc']) + + +test('T7072', + [extra_files(['T7072-main.c', 'T7072-obj.c']), + unless(opsys('linux'), skip), + req_rts_linker], + makefile_test, ['T7072']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721dc35dcc92684138e16968c19f77e299187956 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/721dc35dcc92684138e16968c19f77e299187956 You're receiving 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 14 19:50:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 15:50:15 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/angerman/ghc-8.8-backport-rpath Message-ID: <5f5fc977d6c51_80b3f84663feb2812065917@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/angerman/ghc-8.8-backport-rpath 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 14 19:50:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 15:50:14 -0400 Subject: [Git][ghc/ghc][ghc-8.8] [macOS] improved runpath handling Message-ID: <5f5fc976ba1e0_80b3f845396fbd81206504c@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 3ebc51e6 by Moritz Angermann at 2020-09-11T13:19:37+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> - - - - - 10 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - includes/ghc.mk - settings.in Changes: ===================================== aclocal.m4 ===================================== @@ -566,6 +566,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" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" SettingsCCompilerSupportsNoPie="$CONF_GCC_SUPPORTS_NO_PIE" @@ -581,6 +593,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsPerlCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -945,20 +945,26 @@ dynLoadObjs hsc_env pls objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos pls) - ++ 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 pls) ++ 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 ===================================== @@ -366,7 +366,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? @@ -1888,9 +1937,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" @@ -1959,7 +2011,11 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ debug_opts ++ thread_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 in the runInjectRpaths phase below. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/main/DynFlags.hs ===================================== @@ -92,7 +92,8 @@ module DynFlags ( extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i, + pgm_lcc, pgm_i, pgm_otool, pgm_install_name_tool, opt_L, opt_P, + opt_F, opt_c, opt_a, opt_l, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -1323,6 +1324,8 @@ data Settings = Settings { sPgm_windres :: String, sPgm_libtool :: String, sPgm_ar :: String, + sPgm_otool :: String, + sPgm_install_name_tool :: String, sPgm_ranlib :: String, sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler @@ -1394,6 +1397,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = sPgm_lcc (settings dflags) pgm_ar :: DynFlags -> String pgm_ar dflags = sPgm_ar (settings dflags) +pgm_otool :: DynFlags -> String +pgm_otool dflags = sPgm_otool (settings dflags) +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = sPgm_install_name_tool (settings dflags) pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = sPgm_ranlib (settings dflags) pgm_lo :: DynFlags -> (String,[Option]) @@ -3020,7 +3027,10 @@ dynamic_flags_deps = [ (hasArg (\f -> alterSettings (\s -> s { sPgm_ar = f}))) , make_ord_flag defFlag "pgmranlib" (hasArg (\f -> alterSettings (\s -> s { sPgm_ranlib = f}))) - + , make_ord_flag defFlag "pgmotool" + (hasArg (\f -> alterSettings (\s -> s { sPgm_otool = f}))) + , make_ord_flag defFlag "pgminstall_name_tool" + (hasArg (\f -> alterSettings (\s -> s { sPgm_install_name_tool = f}))) -- need to appear before -optl/-opta to be parsed as LLVM flags. , make_ord_flag defFlag "optlo" @@ -4468,7 +4478,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -4479,6 +4488,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -4519,6 +4530,24 @@ 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. +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/SysTools.hs ===================================== @@ -229,6 +229,8 @@ initSysTools top_dir libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" ranlib_path <- getToolSetting "ranlib command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" tmpdir <- getTemporaryDirectory @@ -306,6 +308,8 @@ initSysTools top_dir sPgm_libtool = libtool_path, sPgm_ar = ar_path, sPgm_ranlib = ranlib_path, + sPgm_otool = otool_path, + sPgm_install_name_tool = install_name_tool_path, sPgm_lo = (lo_prog,[]), sPgm_lc = (lc_prog,[]), sPgm_lcc = (lcc_prog,[]), @@ -415,7 +419,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] @@ -538,8 +545,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/Tasks.hs ===================================== @@ -26,6 +26,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 (()) + {- ************************************************************************ * * @@ -220,6 +224,39 @@ figureLlvmVersion dflags = do llvmVersionStr supportedLlvmVersion) ] 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 = do @@ -301,6 +338,17 @@ askAr dflags mb_cwd args = 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 = do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -651,6 +651,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 @@ -1413,6 +1425,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 ===================================== @@ -87,6 +87,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with ``-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 ===================================== includes/ghc.mk ===================================== @@ -154,7 +154,7 @@ $(includes_H_PLATFORM) : includes/Makefile | $$(dir $$@)/. @echo "#define $(TargetPlatform_CPP)_TARGET 1" >> $@ @echo "#define $(TargetArch_CPP)_TARGET_ARCH 1" >> $@ @echo "#define TARGET_ARCH \"$(TargetArch_CPP)\"" >> $@ - @echo "#define $(TargetOS_CPP)_TARGET_OS 1" >> $@ + @echo "#define $(TargetOS_CPP)_TARGET_OS 1" >> $@ @echo "#define TARGET_OS \"$(TargetOS_CPP)\"" >> $@ @echo "#define $(TargetVendor_CPP)_TARGET_VENDOR 1" >> $@ ifeq "$(GhcUnregisterised)" "YES" @@ -229,4 +229,3 @@ install_includes : $(INSTALL_HEADER) $(INSTALL_OPTS) includes/$d/*.h "$(DESTDIR)$(ghcheaderdir)/$d/" && \ ) true $(INSTALL_HEADER) $(INSTALL_OPTS) $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_H_VERSION) $(includes_DERIVEDCONSTANTS) "$(DESTDIR)$(ghcheaderdir)/" - ===================================== settings.in ===================================== @@ -15,6 +15,8 @@ ("ar flags", "@ArArgs@"), ("ar supports at file", "@ArSupportsAtFile@"), ("ranlib command", "@SettingsRanlibCommand@"), + ("otool command", "@SettingsOtoolCommand@"), + ("install_name_tool command", "@SettingsInstallNameToolCommand@"), ("touch command", "@SettingsTouchCommand@"), ("dllwrap command", "@SettingsDllWrapCommand@"), ("windres command", "@SettingsWindresCommand@"), @@ -33,4 +35,3 @@ ("LLVM opt command", "@SettingsOptCommand@"), ("LLVM clang command", "@SettingsClangCommand@") ] - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ebc51e667d3b41735f28eee7a63058989765009 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ebc51e667d3b41735f28eee7a63058989765009 You're receiving 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 14 19:51:56 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 14 Sep 2020 15:51:56 -0400 Subject: [Git][ghc/ghc][wip/parsing-shift] 65 commits: testsuite: Add broken test for #18302 Message-ID: <5f5fc9dcada7_80bd91b7b812066750@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/parsing-shift 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 - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 8e7315ae by Vladislav Zavialov at 2020-09-14T22:50:20+03:00 Require happy >=1.20 - - - - - d565984c by Ben Gamari at 2020-09-14T22:50:42+03:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - b25cf155 by Vladislav Zavialov at 2020-09-14T22:51:18+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.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/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6f9b4fece701752dcab1ecc0599fedd35817a74...b25cf155cd5132b686d882ba84e71108db3f0203 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6f9b4fece701752dcab1ecc0599fedd35817a74...b25cf155cd5132b686d882ba84e71108db3f0203 You're receiving 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 14 19:51:07 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 14 Sep 2020 15:51:07 -0400 Subject: [Git][ghc/ghc][wip/happy-1.20] 64 commits: testsuite: Add broken test for #18302 Message-ID: <5f5fc9abc706c_80b3f841e6b4ea0120661e7@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/happy-1.20 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 - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 8e7315ae by Vladislav Zavialov at 2020-09-14T22:50:20+03:00 Require happy >=1.20 - - - - - d565984c by Ben Gamari at 2020-09-14T22:50:42+03:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.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/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f4879416b5d27b110d5abb58f8a692e6a92d7a...d565984c54c82305349e215b0332253f6ed592d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84f4879416b5d27b110d5abb58f8a692e6a92d7a...d565984c54c82305349e215b0332253f6ed592d9 You're receiving 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 14 21:46:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 14 Sep 2020 17:46:25 -0400 Subject: [Git][ghc/ghc][master] docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f5fe4b1ba02_80b3f847591817c12085143@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 1 changed file: - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1253,7 +1253,7 @@ recommended for everyday use! .. rts-flag:: -B - Sound the bell at the start of each (major) garbage collection. + Sound the bell at the start of each garbage collection. Oddly enough, people really do use this option! Our pal in Durham (England), Paul Callaghan, writes: “Some people here use it for a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35a7b7ecabeba39e53d6dea78ecc2d3eca8b1b24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35a7b7ecabeba39e53d6dea78ecc2d3eca8b1b24 You're receiving 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 14 21:47:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 14 Sep 2020 17:47:01 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Populate gitlab cache after building Message-ID: <5f5fe4d5a01e0_80b3f8495f1765c120878d7@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -229,6 +229,7 @@ lint-release-changelogs: - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" after_script: + - cp -Rf $HOME/.cabal cabal-cache - .gitlab/ci.sh clean tags: - x86_64-linux @@ -258,15 +259,16 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - .gitlab/ci.sh setup - cabal update - - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. + - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --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 - ./boot - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," + after_script: + - cp -Rf $HOME/.cabal cabal-cache cache: key: hadrian-ghci paths: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35a7b7ecabeba39e53d6dea78ecc2d3eca8b1b24...07762eb5cfe735e131a7f017939a6b0ccfb28389 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35a7b7ecabeba39e53d6dea78ecc2d3eca8b1b24...07762eb5cfe735e131a7f017939a6b0ccfb28389 You're receiving 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 14 21:47:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 17:47:19 -0400 Subject: [Git][ghc/ghc][wip/T18126] 2 commits: Drop redundant import Message-ID: <5f5fe4e755417_80b3f8495f1765c120880f5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: f5b372fd by Ben Gamari at 2020-09-14T17:47:13-04:00 Drop redundant import - - - - - 43d23602 by Ben Gamari at 2020-09-14T17:47:13-04:00 release notes: Make mention of Quick Look impredicativity This will be merged for GHC 9.2. - - - - - 2 changed files: - compiler/GHC/Tc/TyCl.hs - docs/users_guide/9.2.1-notes.rst Changes: ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -58,7 +58,6 @@ import GHC.Core.Class import GHC.Core.Coercion.Axiom import GHC.Core.TyCon import GHC.Core.DataCon -import GHC.Hs.Decls( newOrDataToFlavour ) import GHC.Types.Id import GHC.Types.Var import GHC.Types.Var.Env ===================================== docs/users_guide/9.2.1-notes.rst ===================================== @@ -3,6 +3,13 @@ Version 9.2.1 ============== +Highlights +---------- + +* GHC now has much better support for :extension:`impredicative types + `, as described in *A quick look at impredicativity* + (ICFP 2020). + Compiler ~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c66bd345539ebf828819a538b03171128408d0...43d23602964995288e2b2683b9f16faddd8d7b5b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9c66bd345539ebf828819a538b03171128408d0...43d23602964995288e2b2683b9f16faddd8d7b5b You're receiving 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 14 22:25:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 18:25:35 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f5feddfd7933_80bad950a812104096@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 416f106e by Ben Gamari at 2020-09-14T18:25:25-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + struct ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,12 +1239,16 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; } ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/416f106e2e547285a3c296799fa161de7afc689d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/416f106e2e547285a3c296799fa161de7afc689d You're receiving 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 14 22:30:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 18:30:51 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump version to 9.0 Message-ID: <5f5fef1b7e504_80b8355a18121062e4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: b0ac6875 by Ben Gamari at 2020-09-14T18:30:42-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (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.1.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 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit 2a15172bde75ec151a52fef586d1e362d478aae8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0ac687586ad124d0835a671ce15a09f5ca4cbef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0ac687586ad124d0835a671ce15a09f5ca4cbef You're receiving 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 14 22:48:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 14 Sep 2020 18:48:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f5ff3369936_80bd529218121156e6@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 56ae5826 by Simon Peyton Jones at 2020-09-14T18:48:05-04: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. - - - - - c1d1d8ef by Zubin Duggal at 2020-09-14T18:48:07-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - ac3f506a by Ryan Scott at 2020-09-14T18:48:07-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 29 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - docs/users_guide/runtime_control.rst - + 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: ===================================== .gitlab-ci.yml ===================================== @@ -229,6 +229,7 @@ lint-release-changelogs: - git checkout .gitmodules - "git fetch https://gitlab.haskell.org/ghc/ghc-performance-notes.git refs/notes/perf:refs/notes/perf || true" after_script: + - cp -Rf $HOME/.cabal cabal-cache - .gitlab/ci.sh clean tags: - x86_64-linux @@ -258,15 +259,16 @@ hadrian-ghc-in-ghci: tags: - x86_64-linux script: + - .gitlab/ci.sh setup - cabal update - - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. + - cd hadrian; cabal new-build -j`../mk/detect-cpu-count.sh` --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 - ./boot - ./configure $CONFIGURE_ARGS # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," + after_script: + - cp -Rf $HOME/.cabal cabal-cache cache: key: hadrian-ghci paths: ===================================== 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/Hs/Decls.hs ===================================== @@ -25,7 +25,8 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, - HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour, + HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, + NewOrData(..), newOrDataToFlavour, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -1321,15 +1322,8 @@ data HsDerivingClause pass , deriv_clause_strategy :: Maybe (LDerivStrategy pass) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. - , deriv_clause_tys :: XRec pass [LHsSigType pass] + , deriv_clause_tys :: LDerivClauseTys pass -- ^ The types to derive. - -- - -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@, - -- we can mention type variables that aren't bound by the datatype, e.g. - -- - -- > data T b = ... deriving (C [a]) - -- - -- should produce a derived instance for @C [a] (T b)@. } | XHsDerivingClause !(XXHsDerivingClause pass) @@ -1342,16 +1336,9 @@ instance OutputableBndrId p , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" , pp_strat_before - , pp_dct dct + , ppr dct , pp_strat_after ] where - -- This complexity is to distinguish between - -- deriving Show - -- deriving (Show) - pp_dct [HsIB { hsib_body = ty }] - = ppr (parenthesizeHsType appPrec ty) - pp_dct _ = parens (interpp'SP dct) - -- @via@ is unique in that in comes /after/ the class being derived, -- so we must special-case it. (pp_strat_before, pp_strat_after) = @@ -1359,6 +1346,43 @@ instance OutputableBndrId p Just (L _ via at ViaStrategy{}) -> (empty, ppr via) _ -> (ppDerivStrategy dcs, empty) +type LDerivClauseTys pass = XRec pass (DerivClauseTys pass) + +-- | The types mentioned in a single @deriving@ clause. This can come in two +-- forms, 'DctSingle' or 'DctMulti', depending on whether the types are +-- surrounded by enclosing parentheses or not. These parentheses are +-- semantically differnt than 'HsParTy'. For example, @deriving ()@ means +-- \"derive zero classes\" rather than \"derive an instance of the 0-tuple\". +-- +-- 'DerivClauseTys' use 'LHsSigType' because @deriving@ clauses can mention +-- type variables that aren't bound by the datatype, e.g. +-- +-- > data T b = ... deriving (C [a]) +-- +-- should produce a derived instance for @C [a] (T b)@. +data DerivClauseTys pass + = -- | A @deriving@ clause with a single type. Moreover, that type can only + -- be a type constructor without any arguments. + -- + -- Example: @deriving Eq@ + DctSingle (XDctSingle pass) (LHsSigType pass) + + -- | A @deriving@ clause with a comma-separated list of types, surrounded + -- by enclosing parentheses. + -- + -- Example: @deriving (Eq, C a)@ + | DctMulti (XDctMulti pass) [LHsSigType pass] + + | XDerivClauseTys !(XXDerivClauseTys pass) + +type instance XDctSingle (GhcPass _) = NoExtField +type instance XDctMulti (GhcPass _) = NoExtField +type instance XXDerivClauseTys (GhcPass _) = NoExtCon + +instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where + ppr (DctSingle _ ty) = ppr ty + ppr (DctMulti _ tys) = parens (interpp'SP tys) + -- | Located Standalone Kind Signature type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -446,6 +446,12 @@ type family XXHsDataDefn x type family XCHsDerivingClause x type family XXHsDerivingClause x +-- ------------------------------------- +-- DerivClauseTys type families +type family XDctSingle x +type family XDctMulti x +type family XXDerivClauseTys x + -- ------------------------------------- -- ConDecl type families type family XConDeclGADT x ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -163,6 +163,11 @@ deriving instance Data (HsDerivingClause GhcPs) deriving instance Data (HsDerivingClause GhcRn) deriving instance Data (HsDerivingClause GhcTc) +-- deriving instance DataIdLR p p => Data (DerivClauseTys p) +deriving instance Data (DerivClauseTys GhcPs) +deriving instance Data (DerivClauseTys GhcRn) +deriving instance Data (DerivClauseTys GhcTc) + -- deriving instance (DataIdLR p p) => Data (ConDecl p) deriving instance Data (ConDecl GhcPs) deriving instance Data (ConDecl GhcRn) ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -193,13 +193,19 @@ subordinates instMap decl = case decl of , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ - concatMap (unLoc . deriv_clause_tys . unLoc) $ + | (l, doc) <- concatMap (extract_deriv_clause_tys . + deriv_clause_tys . unLoc) $ unLoc $ dd_derivs dd , Just instName <- [lookupSrcSpan l instMap] ] - extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) - extract_deriv_ty (L l ty) = + extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)] + extract_deriv_clause_tys (L _ dct) = + case dct of + DctSingle _ ty -> maybeToList $ extract_deriv_ty ty + DctMulti _ tys -> mapMaybe extract_deriv_ty tys + + extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty (HsIB{hsib_body = L l ty}) = case ty of -- deriving (forall a. C a {- ^ Doc comment -}) HsForAllTy{ hst_tele = HsForAllInvis{} ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -945,13 +945,18 @@ repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M TH.DerivClause)) repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ dct })) + , deriv_clause_tys = dct })) = repDerivStrategy dcs $ \(MkC dcs') -> - do MkC dct' <- repListM typeTyConName (rep_deriv_ty . hsSigType) dct + do MkC dct' <- rep_deriv_clause_tys dct rep2 derivClauseName [dcs',dct'] where - rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type)) - rep_deriv_ty ty = repLTy ty + rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type]) + rep_deriv_clause_tys (L _ dct) = case dct of + DctSingle _ ty -> rep_deriv_tys [ty] + DctMulti _ tys -> rep_deriv_tys tys + + rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type]) + rep_deriv_tys = repListM typeTyConName (repLTy . hsSigType) rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn -> MetaM ([GenSymBind], [Core (M TH.Dec)]) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) @@ -1507,12 +1507,16 @@ instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where instance ToHie (Located (HsDerivingClause GhcRn)) where toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat (L ispan tys) -> + HsDerivingClause _ strat dct -> [ toHie strat - , locOnly ispan - , toHie $ map (TS (ResolvedScopes [])) tys + , toHie dct ] +instance ToHie (Located (DerivClauseTys GhcRn)) where + toHie (L span dct) = concatM $ makeNode dct span : case dct of + DctSingle _ ty -> [ toHie $ TS (ResolvedScopes[]) ty ] + DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] + instance ToHie (Located (DerivStrategy GhcRn)) where toHie (L span strat) = concatM $ makeNode strat span : case strat of StockStrategy -> [] ===================================== compiler/GHC/Parser.y ===================================== @@ -2276,15 +2276,13 @@ deriving :: { LHsDerivingClause GhcPs } in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2) [mj AnnDeriving $1] } -deriv_clause_types :: { Located [LHsSigType GhcPs] } +deriv_clause_types :: { LDerivClauseTys GhcPs } : qtycon { let { tc = sL1 $1 (HsTyVar noExtField NotPromoted $1) } in - sL1 $1 [mkLHsSigType tc] } - | '(' ')' {% ams (sLL $1 $> []) + sL1 $1 (DctSingle noExtField (mkLHsSigType tc)) } + | '(' ')' {% ams (sLL $1 $> (DctMulti noExtField [])) [mop $1,mcp $2] } - | '(' deriv_types ')' {% ams (sLL $1 $> $2) + | '(' deriv_types ')' {% ams (sLL $1 $> (DctMulti noExtField $2)) [mop $1,mcp $3] } - -- Glasgow extension: allow partial - -- applications in derivings ----------------------------------------------------------------------------- -- Value definitions ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -628,15 +628,34 @@ instance HasHaddock (Located (HsDerivingClause GhcPs)) where Just (L l (ViaStrategy _)) -> (pure (), registerLocHdkA l) Just (L l _) -> (registerLocHdkA l, pure ()) register_strategy_before - deriv_clause_tys' <- - extendHdkA (getLoc deriv_clause_tys) $ - traverse @Located addHaddock deriv_clause_tys + deriv_clause_tys' <- addHaddock deriv_clause_tys register_strategy_after pure HsDerivingClause { deriv_clause_ext = noExtField, deriv_clause_strategy, deriv_clause_tys = deriv_clause_tys' } +-- Process the types in a single deriving clause, which may come in one of the +-- following forms: +-- +-- 1. A singular type constructor: +-- deriving Eq -- ^ Comment on Eq +-- +-- 2. A list of comma-separated types surrounded by enclosing parentheses: +-- deriving ( Eq -- ^ Comment on Eq +-- , C a -- ^ Comment on C a +-- ) +instance HasHaddock (Located (DerivClauseTys GhcPs)) where + addHaddock (L l_dct dct) = + extendHdkA l_dct $ + case dct of + DctSingle x ty -> do + ty' <- addHaddock ty + pure $ L l_dct $ DctSingle x ty' + DctMulti x tys -> do + tys' <- addHaddock tys + pure $ L l_dct $ DctMulti x tys' + -- Process a single data constructor declaration, which may come in one of the -- following forms: -- ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1895,15 +1895,25 @@ rnLHsDerivingClause doc (L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs - , deriv_clause_tys = L loc' dct })) + , deriv_clause_tys = dct })) = do { (dcs', dct', fvs) - <- rnLDerivStrategy doc dcs $ mapFvRn rn_clause_pred dct + <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct ; warnNoDerivStrat dcs' loc ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs' - , deriv_clause_tys = L loc' dct' }) + , deriv_clause_tys = dct' }) , fvs ) } where + rn_deriv_clause_tys :: LDerivClauseTys GhcPs + -> RnM (LDerivClauseTys GhcRn, FreeVars) + rn_deriv_clause_tys (L l dct) = case dct of + DctSingle x ty -> do + (ty', fvs) <- rn_clause_pred ty + pure (L l (DctSingle x ty'), fvs) + DctMulti x tys -> do + (tys', fvs) <- mapFvRn rn_clause_pred tys + pure (L l (DctMulti x tys'), fvs) + rn_clause_pred :: LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars) rn_clause_pred pred_ty = do let inf_err = Just (text "Inferred type variables are not allowed") ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -437,17 +437,22 @@ makeDerivSpecs :: [DerivInfo] -> TcM [EarlyDerivSpec] makeDerivSpecs deriv_infos deriv_decls = do { eqns1 <- sequenceA - [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt + [ deriveClause rep_tc scoped_tvs dcs (deriv_clause_preds dct) err_ctxt | DerivInfo { di_rep_tc = rep_tc , di_scoped_tvs = scoped_tvs , di_clauses = clauses , di_ctxt = err_ctxt } <- deriv_infos , L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ preds }) + , deriv_clause_tys = dct }) <- clauses ] ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls ; return $ concat eqns1 ++ catMaybes eqns2 } + where + deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn] + deriv_clause_preds (L _ dct) = case dct of + DctSingle _ ty -> [ty] + DctMulti _ tys -> tys ------------------------------------------------------------------ -- | Process the derived classes in a single @deriving@ clause. ===================================== 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 ===================================== @@ -1374,7 +1374,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 ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1393,12 +1393,25 @@ cvtContext p tys = do { preds' <- mapM cvtPred tys cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType +cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs) +cvtDerivClauseTys tys + = do { tys' <- mapM cvtType tys + -- Since TH.Cxt doesn't indicate the presence or absence of + -- parentheses in a deriving clause, we have to choose between + -- DctSingle and DctMulti somewhat arbitrarily. We opt to use DctMulti + -- unless the TH.Cxt is a singleton list whose type is a bare type + -- constructor with no arguments. + ; case tys' of + [ty'@(L l (HsTyVar _ NotPromoted _))] + -> return $ L l $ DctSingle noExtField $ mkLHsSigType ty' + _ -> returnL $ DctMulti noExtField (map mkLHsSigType tys') } + cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) -cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt - ; ds' <- traverse cvtDerivStrategy ds - ; returnL $ HsDerivingClause noExtField ds' ctxt' } +cvtDerivClause (TH.DerivClause ds tys) + = do { tys' <- cvtDerivClauseTys tys + ; ds' <- traverse cvtDerivStrategy ds + ; returnL $ HsDerivingClause noExtField ds' tys' } cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -1253,7 +1253,7 @@ recommended for everyday use! .. rts-flag:: -B - Sound the bell at the start of each (major) garbage collection. + Sound the bell at the start of each garbage collection. Oddly enough, people really do use this option! Our pal in Durham (England), Paul Callaghan, writes: “Some people here use it for a ===================================== 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/-/compare/dda2198a16ee9abafbd56571c90603f87bef81cf...ac3f506ade42880089957bf5c3ec2e5154d037c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dda2198a16ee9abafbd56571c90603f87bef81cf...ac3f506ade42880089957bf5c3ec2e5154d037c6 You're receiving 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 14 22:59:16 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 18:59:16 -0400 Subject: [Git][ghc/ghc][wip/T18587] 49 commits: rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f5ff5c469cbe_80b8df4f3c121174a1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18587 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. - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - a64e94f9 by Ben Gamari at 2020-09-14T18:59:08-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. - - - - - 30 changed files: - .gitignore - .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/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/TyCo/Subst.hs - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a9063e9b30f43d2e2767bcdec702b020c6bd11a...a64e94f98ca18e53ecc13f736d50b9cb2d156b05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a9063e9b30f43d2e2767bcdec702b020c6bd11a...a64e94f98ca18e53ecc13f736d50b9cb2d156b05 You're receiving 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 14 23:54:08 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 19:54:08 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f6002a037cf_80b1165232012119591@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 45e90be8 by Ben Gamari at 2020-09-14T19:54:01-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + struct ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,12 +1239,16 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } oc->stable_ptrs = NULL; } ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e90be85e07de47944e6e0af5440894716a60db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45e90be85e07de47944e6e0af5440894716a60db You're receiving 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 14 23:55:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 14 Sep 2020 19:55:11 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f6002dff3cc1_80b3f848d0c891412119936@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: d510d975 by Ben Gamari at 2020-09-14T19:54:47-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + struct ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_ptrs = NULL; } static void @@ -1404,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d510d9759deec1d0b194b99f3c65e971ced67bf1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d510d9759deec1d0b194b99f3c65e971ced67bf1 You're receiving 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 15 02:13:08 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Mon, 14 Sep 2020 22:13:08 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] Adds LLVM (AArch64) CI Job Message-ID: <5f6023341b056_80bd4698281212528d@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 256a38d5 by Moritz Angermann at 2020-09-15T02:12:56+00:00 Adds LLVM (AArch64) CI Job - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -477,6 +477,14 @@ validate-x86_64-darwin: tags: - aarch64-linux +.build-aarch64-linux-deb10-llvm: + extends: .build-aarch64-linux-deb10 + stage: full-build + variables: + BUILD_FLAVOUR: perf-llvm + tags: + - aarch64-linux + validate-aarch64-linux-deb10: extends: .build-aarch64-linux-deb10 artifacts: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/256a38d5899edefa7c01327a6bdbdf1c7402f6fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/256a38d5899edefa7c01327a6bdbdf1c7402f6fe You're receiving 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 15 02:16:21 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Mon, 14 Sep 2020 22:16:21 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] Add validate as well. Message-ID: <5f6023f5d5b1e_80b3f849419b8e4121261c7@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: ec1a9788 by Moritz Angermann at 2020-09-15T02:16:09+00:00 Add validate as well. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -477,14 +477,6 @@ validate-x86_64-darwin: tags: - aarch64-linux -.build-aarch64-linux-deb10-llvm: - extends: .build-aarch64-linux-deb10 - stage: full-build - variables: - BUILD_FLAVOUR: perf-llvm - tags: - - aarch64-linux - validate-aarch64-linux-deb10: extends: .build-aarch64-linux-deb10 artifacts: @@ -497,6 +489,20 @@ nightly-aarch64-linux-deb10: variables: TEST_TYPE: slowtest +.build-aarch64-linux-deb10-llvm: + extends: .build-aarch64-linux-deb10 + stage: full-build + variables: + BUILD_FLAVOUR: perf-llvm + tags: + - aarch64-linux + +validate-aarch64-linux-deb10-llvm: + extends: .build-aarch64-linux-deb10-llvm + artifacts: + when: always + expire_in: 2 week + ################################# # armv7-linux-deb10 ################################# View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec1a9788cff5bff38bbce0441ac43f02decdccae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec1a9788cff5bff38bbce0441ac43f02decdccae You're receiving 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 15 02:48:37 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Mon, 14 Sep 2020 22:48:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-8.6-tsan Message-ID: <5f602b858ae93_80bac66b2812127234@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-8.6-tsan at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-8.6-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 Tue Sep 15 06:38:44 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 02:38:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Fix rtsopts documentation Message-ID: <5f60617453e9b_80b3f8428383d6c1214611@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5ed31f64 by DenisFrezzato at 2020-09-15T02:38:29-04:00 Fix rtsopts documentation - - - - - dbb4f9d6 by Simon Peyton Jones at 2020-09-15T02:38:30-04: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. - - - - - e3350f96 by Zubin Duggal at 2020-09-15T02:38:32-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - 15748dcb by Ryan Scott at 2020-09-15T02:38:32-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 28 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - docs/users_guide/phases.rst - + 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/Hs/Decls.hs ===================================== @@ -25,7 +25,8 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, - HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour, + HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, + NewOrData(..), newOrDataToFlavour, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -1321,15 +1322,8 @@ data HsDerivingClause pass , deriv_clause_strategy :: Maybe (LDerivStrategy pass) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. - , deriv_clause_tys :: XRec pass [LHsSigType pass] + , deriv_clause_tys :: LDerivClauseTys pass -- ^ The types to derive. - -- - -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@, - -- we can mention type variables that aren't bound by the datatype, e.g. - -- - -- > data T b = ... deriving (C [a]) - -- - -- should produce a derived instance for @C [a] (T b)@. } | XHsDerivingClause !(XXHsDerivingClause pass) @@ -1342,16 +1336,9 @@ instance OutputableBndrId p , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" , pp_strat_before - , pp_dct dct + , ppr dct , pp_strat_after ] where - -- This complexity is to distinguish between - -- deriving Show - -- deriving (Show) - pp_dct [HsIB { hsib_body = ty }] - = ppr (parenthesizeHsType appPrec ty) - pp_dct _ = parens (interpp'SP dct) - -- @via@ is unique in that in comes /after/ the class being derived, -- so we must special-case it. (pp_strat_before, pp_strat_after) = @@ -1359,6 +1346,43 @@ instance OutputableBndrId p Just (L _ via at ViaStrategy{}) -> (empty, ppr via) _ -> (ppDerivStrategy dcs, empty) +type LDerivClauseTys pass = XRec pass (DerivClauseTys pass) + +-- | The types mentioned in a single @deriving@ clause. This can come in two +-- forms, 'DctSingle' or 'DctMulti', depending on whether the types are +-- surrounded by enclosing parentheses or not. These parentheses are +-- semantically differnt than 'HsParTy'. For example, @deriving ()@ means +-- \"derive zero classes\" rather than \"derive an instance of the 0-tuple\". +-- +-- 'DerivClauseTys' use 'LHsSigType' because @deriving@ clauses can mention +-- type variables that aren't bound by the datatype, e.g. +-- +-- > data T b = ... deriving (C [a]) +-- +-- should produce a derived instance for @C [a] (T b)@. +data DerivClauseTys pass + = -- | A @deriving@ clause with a single type. Moreover, that type can only + -- be a type constructor without any arguments. + -- + -- Example: @deriving Eq@ + DctSingle (XDctSingle pass) (LHsSigType pass) + + -- | A @deriving@ clause with a comma-separated list of types, surrounded + -- by enclosing parentheses. + -- + -- Example: @deriving (Eq, C a)@ + | DctMulti (XDctMulti pass) [LHsSigType pass] + + | XDerivClauseTys !(XXDerivClauseTys pass) + +type instance XDctSingle (GhcPass _) = NoExtField +type instance XDctMulti (GhcPass _) = NoExtField +type instance XXDerivClauseTys (GhcPass _) = NoExtCon + +instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where + ppr (DctSingle _ ty) = ppr ty + ppr (DctMulti _ tys) = parens (interpp'SP tys) + -- | Located Standalone Kind Signature type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -446,6 +446,12 @@ type family XXHsDataDefn x type family XCHsDerivingClause x type family XXHsDerivingClause x +-- ------------------------------------- +-- DerivClauseTys type families +type family XDctSingle x +type family XDctMulti x +type family XXDerivClauseTys x + -- ------------------------------------- -- ConDecl type families type family XConDeclGADT x ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -163,6 +163,11 @@ deriving instance Data (HsDerivingClause GhcPs) deriving instance Data (HsDerivingClause GhcRn) deriving instance Data (HsDerivingClause GhcTc) +-- deriving instance DataIdLR p p => Data (DerivClauseTys p) +deriving instance Data (DerivClauseTys GhcPs) +deriving instance Data (DerivClauseTys GhcRn) +deriving instance Data (DerivClauseTys GhcTc) + -- deriving instance (DataIdLR p p) => Data (ConDecl p) deriving instance Data (ConDecl GhcPs) deriving instance Data (ConDecl GhcRn) ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -193,13 +193,19 @@ subordinates instMap decl = case decl of , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ - concatMap (unLoc . deriv_clause_tys . unLoc) $ + | (l, doc) <- concatMap (extract_deriv_clause_tys . + deriv_clause_tys . unLoc) $ unLoc $ dd_derivs dd , Just instName <- [lookupSrcSpan l instMap] ] - extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) - extract_deriv_ty (L l ty) = + extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)] + extract_deriv_clause_tys (L _ dct) = + case dct of + DctSingle _ ty -> maybeToList $ extract_deriv_ty ty + DctMulti _ tys -> mapMaybe extract_deriv_ty tys + + extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty (HsIB{hsib_body = L l ty}) = case ty of -- deriving (forall a. C a {- ^ Doc comment -}) HsForAllTy{ hst_tele = HsForAllInvis{} ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -945,13 +945,18 @@ repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M TH.DerivClause)) repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ dct })) + , deriv_clause_tys = dct })) = repDerivStrategy dcs $ \(MkC dcs') -> - do MkC dct' <- repListM typeTyConName (rep_deriv_ty . hsSigType) dct + do MkC dct' <- rep_deriv_clause_tys dct rep2 derivClauseName [dcs',dct'] where - rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type)) - rep_deriv_ty ty = repLTy ty + rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type]) + rep_deriv_clause_tys (L _ dct) = case dct of + DctSingle _ ty -> rep_deriv_tys [ty] + DctMulti _ tys -> rep_deriv_tys tys + + rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type]) + rep_deriv_tys = repListM typeTyConName (repLTy . hsSigType) rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn -> MetaM ([GenSymBind], [Core (M TH.Dec)]) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) @@ -1507,12 +1507,16 @@ instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where instance ToHie (Located (HsDerivingClause GhcRn)) where toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat (L ispan tys) -> + HsDerivingClause _ strat dct -> [ toHie strat - , locOnly ispan - , toHie $ map (TS (ResolvedScopes [])) tys + , toHie dct ] +instance ToHie (Located (DerivClauseTys GhcRn)) where + toHie (L span dct) = concatM $ makeNode dct span : case dct of + DctSingle _ ty -> [ toHie $ TS (ResolvedScopes[]) ty ] + DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] + instance ToHie (Located (DerivStrategy GhcRn)) where toHie (L span strat) = concatM $ makeNode strat span : case strat of StockStrategy -> [] ===================================== compiler/GHC/Parser.y ===================================== @@ -2276,15 +2276,13 @@ deriving :: { LHsDerivingClause GhcPs } in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2) [mj AnnDeriving $1] } -deriv_clause_types :: { Located [LHsSigType GhcPs] } +deriv_clause_types :: { LDerivClauseTys GhcPs } : qtycon { let { tc = sL1 $1 (HsTyVar noExtField NotPromoted $1) } in - sL1 $1 [mkLHsSigType tc] } - | '(' ')' {% ams (sLL $1 $> []) + sL1 $1 (DctSingle noExtField (mkLHsSigType tc)) } + | '(' ')' {% ams (sLL $1 $> (DctMulti noExtField [])) [mop $1,mcp $2] } - | '(' deriv_types ')' {% ams (sLL $1 $> $2) + | '(' deriv_types ')' {% ams (sLL $1 $> (DctMulti noExtField $2)) [mop $1,mcp $3] } - -- Glasgow extension: allow partial - -- applications in derivings ----------------------------------------------------------------------------- -- Value definitions ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -628,15 +628,34 @@ instance HasHaddock (Located (HsDerivingClause GhcPs)) where Just (L l (ViaStrategy _)) -> (pure (), registerLocHdkA l) Just (L l _) -> (registerLocHdkA l, pure ()) register_strategy_before - deriv_clause_tys' <- - extendHdkA (getLoc deriv_clause_tys) $ - traverse @Located addHaddock deriv_clause_tys + deriv_clause_tys' <- addHaddock deriv_clause_tys register_strategy_after pure HsDerivingClause { deriv_clause_ext = noExtField, deriv_clause_strategy, deriv_clause_tys = deriv_clause_tys' } +-- Process the types in a single deriving clause, which may come in one of the +-- following forms: +-- +-- 1. A singular type constructor: +-- deriving Eq -- ^ Comment on Eq +-- +-- 2. A list of comma-separated types surrounded by enclosing parentheses: +-- deriving ( Eq -- ^ Comment on Eq +-- , C a -- ^ Comment on C a +-- ) +instance HasHaddock (Located (DerivClauseTys GhcPs)) where + addHaddock (L l_dct dct) = + extendHdkA l_dct $ + case dct of + DctSingle x ty -> do + ty' <- addHaddock ty + pure $ L l_dct $ DctSingle x ty' + DctMulti x tys -> do + tys' <- addHaddock tys + pure $ L l_dct $ DctMulti x tys' + -- Process a single data constructor declaration, which may come in one of the -- following forms: -- ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1895,15 +1895,25 @@ rnLHsDerivingClause doc (L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs - , deriv_clause_tys = L loc' dct })) + , deriv_clause_tys = dct })) = do { (dcs', dct', fvs) - <- rnLDerivStrategy doc dcs $ mapFvRn rn_clause_pred dct + <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct ; warnNoDerivStrat dcs' loc ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs' - , deriv_clause_tys = L loc' dct' }) + , deriv_clause_tys = dct' }) , fvs ) } where + rn_deriv_clause_tys :: LDerivClauseTys GhcPs + -> RnM (LDerivClauseTys GhcRn, FreeVars) + rn_deriv_clause_tys (L l dct) = case dct of + DctSingle x ty -> do + (ty', fvs) <- rn_clause_pred ty + pure (L l (DctSingle x ty'), fvs) + DctMulti x tys -> do + (tys', fvs) <- mapFvRn rn_clause_pred tys + pure (L l (DctMulti x tys'), fvs) + rn_clause_pred :: LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars) rn_clause_pred pred_ty = do let inf_err = Just (text "Inferred type variables are not allowed") ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -437,17 +437,22 @@ makeDerivSpecs :: [DerivInfo] -> TcM [EarlyDerivSpec] makeDerivSpecs deriv_infos deriv_decls = do { eqns1 <- sequenceA - [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt + [ deriveClause rep_tc scoped_tvs dcs (deriv_clause_preds dct) err_ctxt | DerivInfo { di_rep_tc = rep_tc , di_scoped_tvs = scoped_tvs , di_clauses = clauses , di_ctxt = err_ctxt } <- deriv_infos , L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ preds }) + , deriv_clause_tys = dct }) <- clauses ] ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls ; return $ concat eqns1 ++ catMaybes eqns2 } + where + deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn] + deriv_clause_preds (L _ dct) = case dct of + DctSingle _ ty -> [ty] + DctMulti _ tys -> tys ------------------------------------------------------------------ -- | Process the derived classes in a single @deriving@ clause. ===================================== 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 ===================================== @@ -1374,7 +1374,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 ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1393,12 +1393,25 @@ cvtContext p tys = do { preds' <- mapM cvtPred tys cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType +cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs) +cvtDerivClauseTys tys + = do { tys' <- mapM cvtType tys + -- Since TH.Cxt doesn't indicate the presence or absence of + -- parentheses in a deriving clause, we have to choose between + -- DctSingle and DctMulti somewhat arbitrarily. We opt to use DctMulti + -- unless the TH.Cxt is a singleton list whose type is a bare type + -- constructor with no arguments. + ; case tys' of + [ty'@(L l (HsTyVar _ NotPromoted _))] + -> return $ L l $ DctSingle noExtField $ mkLHsSigType ty' + _ -> returnL $ DctMulti noExtField (map mkLHsSigType tys') } + cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) -cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt - ; ds' <- traverse cvtDerivStrategy ds - ; returnL $ HsDerivingClause noExtField ds' ctxt' } +cvtDerivClause (TH.DerivClause ds tys) + = do { tys' <- cvtDerivClauseTys tys + ; ds' <- traverse cvtDerivStrategy ds + ; returnL $ HsDerivingClause noExtField ds' tys' } cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy ===================================== docs/users_guide/phases.rst ===================================== @@ -1028,7 +1028,7 @@ for example). This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment - variable. There are three possibilities: + variable. There are five possibilities: ``-rtsopts=none`` Disable all processing of RTS options. If ``+RTS`` appears ===================================== 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/-/compare/ac3f506ade42880089957bf5c3ec2e5154d037c6...15748dcb170fab11d975b501baafc0ab61b98bdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac3f506ade42880089957bf5c3ec2e5154d037c6...15748dcb170fab11d975b501baafc0ab61b98bdb You're receiving 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 15 08:56:52 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 15 Sep 2020 04:56:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18249 Message-ID: <5f6081d4d3bde_80ba487aec1215862b@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18249 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18249 You're receiving 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 15 10:18:35 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 15 Sep 2020 06:18:35 -0400 Subject: [Git][ghc/ghc][wip/T18603] 33 commits: DynFlags: add OptCoercionOpts Message-ID: <5f6094fbc3ab3_80b111162941216845a@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18603 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 704504d1 by Simon Peyton Jones at 2020-09-15T11:17:57+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 - compiler/GHC.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.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/TyCo/Subst.hs - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b2531f680c4d8e034d0b1936ef975648a2b4462...704504d1b2c78b7214d5e8b6af27a4bdf39dae8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b2531f680c4d8e034d0b1936ef975648a2b4462...704504d1b2c78b7214d5e8b6af27a4bdf39dae8f You're receiving 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 15 10:47:31 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 15 Sep 2020 06:47:31 -0400 Subject: [Git][ghc/ghc][wip/T18223] 96 commits: linters: Make CPP linter skip image files Message-ID: <5f609bc3db3b_80bd3e7df0121761aa@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18223 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 56ac867d by Simon Peyton Jones at 2020-09-15T11:46:45+01:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 29 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/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf9cde7313d1d8dc6edd0485a25f3da729de615...56ac867d3950ef22649b1970815fa8cf99f89402 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bf9cde7313d1d8dc6edd0485a25f3da729de615...56ac867d3950ef22649b1970815fa8cf99f89402 You're receiving 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 15 11:46:44 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 15 Sep 2020 07:46:44 -0400 Subject: [Git][ghc/ghc][wip/T18638] 21 commits: .gitignore *.hiedb files Message-ID: <5f60a9a4ce78c_80b3f840624911c121780c1@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18638 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 995d3a34 by Simon Peyton Jones at 2020-09-15T12:46:13+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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 25 changed files: - .gitignore - .gitlab-ci.yml - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.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/HsToCore/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04f0cae614fecbd20581326fdebdc74282305027...995d3a34b20e9a1b77833d0aac1e31578ef7b473 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04f0cae614fecbd20581326fdebdc74282305027...995d3a34b20e9a1b77833d0aac1e31578ef7b473 You're receiving 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 15 12:39:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 08:39:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix rtsopts documentation Message-ID: <5f60b5ed2750b_80b3f848d8a1ec412191341@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 12df556f by DenisFrezzato at 2020-09-15T08:38:50-04:00 Fix rtsopts documentation - - - - - feb39b40 by Simon Peyton Jones at 2020-09-15T08:38:52-04: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. - - - - - 46405e53 by Zubin Duggal at 2020-09-15T08:38:53-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - e7327efb by Sylvain Henry at 2020-09-15T08:38:56-04:00 Enhance metrics output - - - - - 9b49af09 by Ryan Scott at 2020-09-15T08:38:57-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 30 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - docs/users_guide/phases.rst - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - + 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/Hs/Decls.hs ===================================== @@ -25,7 +25,8 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, - HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour, + HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, + NewOrData(..), newOrDataToFlavour, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -1321,15 +1322,8 @@ data HsDerivingClause pass , deriv_clause_strategy :: Maybe (LDerivStrategy pass) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. - , deriv_clause_tys :: XRec pass [LHsSigType pass] + , deriv_clause_tys :: LDerivClauseTys pass -- ^ The types to derive. - -- - -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@, - -- we can mention type variables that aren't bound by the datatype, e.g. - -- - -- > data T b = ... deriving (C [a]) - -- - -- should produce a derived instance for @C [a] (T b)@. } | XHsDerivingClause !(XXHsDerivingClause pass) @@ -1342,16 +1336,9 @@ instance OutputableBndrId p , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" , pp_strat_before - , pp_dct dct + , ppr dct , pp_strat_after ] where - -- This complexity is to distinguish between - -- deriving Show - -- deriving (Show) - pp_dct [HsIB { hsib_body = ty }] - = ppr (parenthesizeHsType appPrec ty) - pp_dct _ = parens (interpp'SP dct) - -- @via@ is unique in that in comes /after/ the class being derived, -- so we must special-case it. (pp_strat_before, pp_strat_after) = @@ -1359,6 +1346,43 @@ instance OutputableBndrId p Just (L _ via at ViaStrategy{}) -> (empty, ppr via) _ -> (ppDerivStrategy dcs, empty) +type LDerivClauseTys pass = XRec pass (DerivClauseTys pass) + +-- | The types mentioned in a single @deriving@ clause. This can come in two +-- forms, 'DctSingle' or 'DctMulti', depending on whether the types are +-- surrounded by enclosing parentheses or not. These parentheses are +-- semantically differnt than 'HsParTy'. For example, @deriving ()@ means +-- \"derive zero classes\" rather than \"derive an instance of the 0-tuple\". +-- +-- 'DerivClauseTys' use 'LHsSigType' because @deriving@ clauses can mention +-- type variables that aren't bound by the datatype, e.g. +-- +-- > data T b = ... deriving (C [a]) +-- +-- should produce a derived instance for @C [a] (T b)@. +data DerivClauseTys pass + = -- | A @deriving@ clause with a single type. Moreover, that type can only + -- be a type constructor without any arguments. + -- + -- Example: @deriving Eq@ + DctSingle (XDctSingle pass) (LHsSigType pass) + + -- | A @deriving@ clause with a comma-separated list of types, surrounded + -- by enclosing parentheses. + -- + -- Example: @deriving (Eq, C a)@ + | DctMulti (XDctMulti pass) [LHsSigType pass] + + | XDerivClauseTys !(XXDerivClauseTys pass) + +type instance XDctSingle (GhcPass _) = NoExtField +type instance XDctMulti (GhcPass _) = NoExtField +type instance XXDerivClauseTys (GhcPass _) = NoExtCon + +instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where + ppr (DctSingle _ ty) = ppr ty + ppr (DctMulti _ tys) = parens (interpp'SP tys) + -- | Located Standalone Kind Signature type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -446,6 +446,12 @@ type family XXHsDataDefn x type family XCHsDerivingClause x type family XXHsDerivingClause x +-- ------------------------------------- +-- DerivClauseTys type families +type family XDctSingle x +type family XDctMulti x +type family XXDerivClauseTys x + -- ------------------------------------- -- ConDecl type families type family XConDeclGADT x ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -163,6 +163,11 @@ deriving instance Data (HsDerivingClause GhcPs) deriving instance Data (HsDerivingClause GhcRn) deriving instance Data (HsDerivingClause GhcTc) +-- deriving instance DataIdLR p p => Data (DerivClauseTys p) +deriving instance Data (DerivClauseTys GhcPs) +deriving instance Data (DerivClauseTys GhcRn) +deriving instance Data (DerivClauseTys GhcTc) + -- deriving instance (DataIdLR p p) => Data (ConDecl p) deriving instance Data (ConDecl GhcPs) deriving instance Data (ConDecl GhcRn) ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -193,13 +193,19 @@ subordinates instMap decl = case decl of , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ - concatMap (unLoc . deriv_clause_tys . unLoc) $ + | (l, doc) <- concatMap (extract_deriv_clause_tys . + deriv_clause_tys . unLoc) $ unLoc $ dd_derivs dd , Just instName <- [lookupSrcSpan l instMap] ] - extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) - extract_deriv_ty (L l ty) = + extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)] + extract_deriv_clause_tys (L _ dct) = + case dct of + DctSingle _ ty -> maybeToList $ extract_deriv_ty ty + DctMulti _ tys -> mapMaybe extract_deriv_ty tys + + extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty (HsIB{hsib_body = L l ty}) = case ty of -- deriving (forall a. C a {- ^ Doc comment -}) HsForAllTy{ hst_tele = HsForAllInvis{} ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -945,13 +945,18 @@ repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M TH.DerivClause)) repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ dct })) + , deriv_clause_tys = dct })) = repDerivStrategy dcs $ \(MkC dcs') -> - do MkC dct' <- repListM typeTyConName (rep_deriv_ty . hsSigType) dct + do MkC dct' <- rep_deriv_clause_tys dct rep2 derivClauseName [dcs',dct'] where - rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type)) - rep_deriv_ty ty = repLTy ty + rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type]) + rep_deriv_clause_tys (L _ dct) = case dct of + DctSingle _ ty -> rep_deriv_tys [ty] + DctMulti _ tys -> rep_deriv_tys tys + + rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type]) + rep_deriv_tys = repListM typeTyConName (repLTy . hsSigType) rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn -> MetaM ([GenSymBind], [Core (M TH.Dec)]) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) @@ -1507,12 +1507,16 @@ instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where instance ToHie (Located (HsDerivingClause GhcRn)) where toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat (L ispan tys) -> + HsDerivingClause _ strat dct -> [ toHie strat - , locOnly ispan - , toHie $ map (TS (ResolvedScopes [])) tys + , toHie dct ] +instance ToHie (Located (DerivClauseTys GhcRn)) where + toHie (L span dct) = concatM $ makeNode dct span : case dct of + DctSingle _ ty -> [ toHie $ TS (ResolvedScopes[]) ty ] + DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] + instance ToHie (Located (DerivStrategy GhcRn)) where toHie (L span strat) = concatM $ makeNode strat span : case strat of StockStrategy -> [] ===================================== compiler/GHC/Parser.y ===================================== @@ -2276,15 +2276,13 @@ deriving :: { LHsDerivingClause GhcPs } in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2) [mj AnnDeriving $1] } -deriv_clause_types :: { Located [LHsSigType GhcPs] } +deriv_clause_types :: { LDerivClauseTys GhcPs } : qtycon { let { tc = sL1 $1 (HsTyVar noExtField NotPromoted $1) } in - sL1 $1 [mkLHsSigType tc] } - | '(' ')' {% ams (sLL $1 $> []) + sL1 $1 (DctSingle noExtField (mkLHsSigType tc)) } + | '(' ')' {% ams (sLL $1 $> (DctMulti noExtField [])) [mop $1,mcp $2] } - | '(' deriv_types ')' {% ams (sLL $1 $> $2) + | '(' deriv_types ')' {% ams (sLL $1 $> (DctMulti noExtField $2)) [mop $1,mcp $3] } - -- Glasgow extension: allow partial - -- applications in derivings ----------------------------------------------------------------------------- -- Value definitions ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -628,15 +628,34 @@ instance HasHaddock (Located (HsDerivingClause GhcPs)) where Just (L l (ViaStrategy _)) -> (pure (), registerLocHdkA l) Just (L l _) -> (registerLocHdkA l, pure ()) register_strategy_before - deriv_clause_tys' <- - extendHdkA (getLoc deriv_clause_tys) $ - traverse @Located addHaddock deriv_clause_tys + deriv_clause_tys' <- addHaddock deriv_clause_tys register_strategy_after pure HsDerivingClause { deriv_clause_ext = noExtField, deriv_clause_strategy, deriv_clause_tys = deriv_clause_tys' } +-- Process the types in a single deriving clause, which may come in one of the +-- following forms: +-- +-- 1. A singular type constructor: +-- deriving Eq -- ^ Comment on Eq +-- +-- 2. A list of comma-separated types surrounded by enclosing parentheses: +-- deriving ( Eq -- ^ Comment on Eq +-- , C a -- ^ Comment on C a +-- ) +instance HasHaddock (Located (DerivClauseTys GhcPs)) where + addHaddock (L l_dct dct) = + extendHdkA l_dct $ + case dct of + DctSingle x ty -> do + ty' <- addHaddock ty + pure $ L l_dct $ DctSingle x ty' + DctMulti x tys -> do + tys' <- addHaddock tys + pure $ L l_dct $ DctMulti x tys' + -- Process a single data constructor declaration, which may come in one of the -- following forms: -- ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1895,15 +1895,25 @@ rnLHsDerivingClause doc (L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs - , deriv_clause_tys = L loc' dct })) + , deriv_clause_tys = dct })) = do { (dcs', dct', fvs) - <- rnLDerivStrategy doc dcs $ mapFvRn rn_clause_pred dct + <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct ; warnNoDerivStrat dcs' loc ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs' - , deriv_clause_tys = L loc' dct' }) + , deriv_clause_tys = dct' }) , fvs ) } where + rn_deriv_clause_tys :: LDerivClauseTys GhcPs + -> RnM (LDerivClauseTys GhcRn, FreeVars) + rn_deriv_clause_tys (L l dct) = case dct of + DctSingle x ty -> do + (ty', fvs) <- rn_clause_pred ty + pure (L l (DctSingle x ty'), fvs) + DctMulti x tys -> do + (tys', fvs) <- mapFvRn rn_clause_pred tys + pure (L l (DctMulti x tys'), fvs) + rn_clause_pred :: LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars) rn_clause_pred pred_ty = do let inf_err = Just (text "Inferred type variables are not allowed") ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -437,17 +437,22 @@ makeDerivSpecs :: [DerivInfo] -> TcM [EarlyDerivSpec] makeDerivSpecs deriv_infos deriv_decls = do { eqns1 <- sequenceA - [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt + [ deriveClause rep_tc scoped_tvs dcs (deriv_clause_preds dct) err_ctxt | DerivInfo { di_rep_tc = rep_tc , di_scoped_tvs = scoped_tvs , di_clauses = clauses , di_ctxt = err_ctxt } <- deriv_infos , L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ preds }) + , deriv_clause_tys = dct }) <- clauses ] ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls ; return $ concat eqns1 ++ catMaybes eqns2 } + where + deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn] + deriv_clause_preds (L _ dct) = case dct of + DctSingle _ ty -> [ty] + DctMulti _ tys -> tys ------------------------------------------------------------------ -- | Process the derived classes in a single @deriving@ clause. ===================================== 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 ===================================== @@ -1374,7 +1374,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 ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1393,12 +1393,25 @@ cvtContext p tys = do { preds' <- mapM cvtPred tys cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType +cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs) +cvtDerivClauseTys tys + = do { tys' <- mapM cvtType tys + -- Since TH.Cxt doesn't indicate the presence or absence of + -- parentheses in a deriving clause, we have to choose between + -- DctSingle and DctMulti somewhat arbitrarily. We opt to use DctMulti + -- unless the TH.Cxt is a singleton list whose type is a bare type + -- constructor with no arguments. + ; case tys' of + [ty'@(L l (HsTyVar _ NotPromoted _))] + -> return $ L l $ DctSingle noExtField $ mkLHsSigType ty' + _ -> returnL $ DctMulti noExtField (map mkLHsSigType tys') } + cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) -cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt - ; ds' <- traverse cvtDerivStrategy ds - ; returnL $ HsDerivingClause noExtField ds' ctxt' } +cvtDerivClause (TH.DerivClause ds tys) + = do { tys' <- cvtDerivClauseTys tys + ; ds' <- traverse cvtDerivStrategy ds + ; returnL $ HsDerivingClause noExtField ds' tys' } cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy ===================================== docs/users_guide/phases.rst ===================================== @@ -1028,7 +1028,7 @@ for example). This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment - variable. There are three possibilities: + variable. There are five possibilities: ``-rtsopts=none`` Disable all processing of RTS options. If ``+RTS`` appears ===================================== testsuite/driver/perf_notes.py ===================================== @@ -108,12 +108,12 @@ class MetricChange(Enum): } return strings[self] - def short_name(self): + def hint(self): strings = { - MetricChange.NewMetric: "new", - MetricChange.NoChange: "unch", - MetricChange.Increase: "incr", - MetricChange.Decrease: "decr" + MetricChange.NewMetric: colored(Color.BLUE,"NEW"), + MetricChange.NoChange: "", + MetricChange.Increase: colored(Color.RED, "BAD"), + MetricChange.Decrease: colored(Color.GREEN,"GOOD") } return strings[self] ===================================== testsuite/driver/runtests.py ===================================== @@ -348,21 +348,21 @@ def tabulate_metrics(metrics: List[PerfMetric]) -> None: 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]: + def row(cells: Tuple[str, 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")) + 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) + return "{:+2.1f}%".format(100 * (val1 - val0) / val0) dataRows = [row(( "{}({})".format(x.stat.test, x.stat.way), shorten_metric_name(x.stat.metric), @@ -374,7 +374,8 @@ def tabulate_metrics(metrics: List[PerfMetric]) -> None: "{:13.1f}".format(x.baseline.perfStat.value) if x.baseline is not None else "", "{:13.1f}".format(x.stat.value), - strDiff(x) + strDiff(x), + "{}".format(x.change.hint()) )) for x in sorted(metrics, key = lambda m: (m.stat.test, m.stat.way, m.stat.metric))] print_table(headerRows, dataRows, 1) ===================================== 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/-/compare/15748dcb170fab11d975b501baafc0ab61b98bdb...9b49af09cbcf73c18253adf3e381e46c915d5b13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/15748dcb170fab11d975b501baafc0ab61b98bdb...9b49af09cbcf73c18253adf3e381e46c915d5b13 You're receiving 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 15 12:45:57 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 15 Sep 2020 08:45:57 -0400 Subject: [Git][ghc/ghc][wip/T18249] Refactor to PhiCt Message-ID: <5f60b785ed8ec_80b3f848d8a1ec4121981c7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: f8c2cafe by Sebastian Graf at 2020-09-15T14:45:48+02:00 Refactor to PhiCt - - - - - 2 changed files: - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -850,12 +850,12 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 @@ -927,15 +927,15 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) @@ -947,11 +947,10 @@ checkGrd grd = CA $ \inc -> case grd of -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - let con_cts = phiConCts x con tvs (map evVarPred dicts) args - !matched <- addPmCtsNablas inc con_cts - !uncov <- addPmCtNablas inc (PmNotConCt x con) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt 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 @@ -986,7 +985,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1373,7 +1372,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1385,7 +1385,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -8,7 +8,7 @@ Authors: George Karachalias MultiWayIf, ScopedTypeVariables, MagicHash #-} -- | The pattern match oracle. The main export of the module are the functions --- 'addPmCts' for adding facts to the oracle, and 'generateInhabitants' to turn a +-- 'addPhiCts' for adding facts to the oracle, and 'generateInhabitants' to turn a -- '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) @@ -19,12 +19,9 @@ module GHC.HsToCore.PmCheck.Oracle ( DsM, tracePm, mkPmId, Nabla, initNablas, lookupRefuts, lookupSolution, - PmCt(PmTyCt), PmCts, pattern PmVarCt, pattern PmCoreCt, - pattern PmConCt, pattern PmNotConCt, pattern PmBotCt, - pattern PmNotBotCt, + PhiCt(..), PhiCts, - addPmCts, -- Add a constraint to the oracle. - phiConCts, -- desugar a higher-level φ constructor constraint + addPhiCts, -- Add a constraint to the oracle. generateInhabitants ) where @@ -81,7 +78,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) -import Data.Functor.Identity import Data.List (find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) @@ -102,8 +98,8 @@ tracePm herald doc = do {-# INLINE tracePm #-} -- see Note [INLINE conditional tracing utilities] debugOn :: () -> Bool --- debugOn _ = False -debugOn _ = True +debugOn _ = False +-- debugOn _ = True trc :: String -> SDoc -> a -> a trc | debugOn () = pprTrace @@ -124,11 +120,6 @@ mkPmId ty = getUniqueM >>= \unique -> -- 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) @@ -235,30 +226,6 @@ applies due to refined type information. --------------------------------------------------- -- * Instantiating constructors, types and evidence --- | 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]. TODO --- --- In terms of the paper, this function amounts to the constructor constraint --- case of \(⊕_φ\) in Figure 7, which "desugars" higher-level φ constraints --- into lower-level δ constraints. -phiConCts :: Id -> PmAltCon -> [TyVar] -> [PredType] -> [Id] -> PmCts -phiConCts x con tvs dicts args = (gammas `snocBag` con_ct) `unionBags` unlifted - where - gammas = listToBag $ map PmTyCt dicts - con_ct = PmConCt x con tvs args - unlifted = listToBag [ PmNotBotCt arg - | (arg, bang) <- - zipEqual "pmConCts" args (pmAltConImplBangs con) - , isBanged bang || isUnliftedType (idType arg) - ] - -- | Instantiate a 'ConLike' given its universal type arguments. Instantiates -- existential and term binders with fresh variables of appropriate type. -- Returns instantiated type and term variables from the match, type evidence @@ -289,7 +256,6 @@ mkOneConFull nabla at MkNabla{nabla_ty_st = ty_st} x con = do env <- dsGetFamInstEnvs src_ty <- normalisedSourceType <$> pmTopNormaliseType ty_st (idType x) let mb_arg_tys = guessConLikeUnivTyArgsFromResTy env src_ty con - tracePm "guess" (ppr src_ty $$ ppr mb_arg_tys) case mb_arg_tys of Just arg_tys -> do let (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta, field_tys, _con_res_ty) @@ -313,7 +279,8 @@ mkOneConFull nabla at MkNabla{nabla_ty_st = ty_st} x con = do , ppr gammas , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) ] - runMaybeT $ addPmCtsNoTest nabla $ phiConCts x (PmAltConLike con) ex_tvs gammas arg_ids + -- Note that we add a + runMaybeT $ addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited {- Note [Strict fields and variables of unlifted type] @@ -836,72 +803,52 @@ lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of -- * Adding facts to the oracle -- | A term constraint. -data TmCt - = TmVarCt !Id !Id - -- ^ @TmVarCt x y@ encodes "x ~ y", equating @x@ and @y at . - | TmCoreCt !Id !CoreExpr - -- ^ @TmCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . - | TmConCt !Id !PmAltCon ![TyVar] ![Id] - -- ^ @TmConCt x K tvs ys@ encodes "x ~ K @tvs ys", equating @x@ with the 'PmAltCon' - -- application @K @tvs ys at . - | TmNotConCt !Id !PmAltCon - -- ^ @TmNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed +data PhiCt + = PhiTyCt !PredType + -- ^ A type constraint "T ~ U". + | PhiVarCt !Id !Id + -- ^ @PhiVarCt x y@ encodes "x ~ y", equating @x@ and @y at . + | PhiCoreCt !Id !CoreExpr + -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . + | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] + -- ^ @PhiConCt x K tvs dicts ys@ encodes @K \@tvs dicts ys <- x@, matching @x@ + -- against the 'PmAltCon' application @K \@tvs dicts ys@, binding @tvs@, + -- @dicts@ and possibly unlifted fields @ys@ in the process. + -- See Note [Strict fields and fields of unlifted type]. + | PhiNotConCt !Id !PmAltCon + -- ^ @PhiNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed -- by @K at . - | TmBotCt !Id - -- ^ @TmBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. + | PhiBotCt !Id + -- ^ @PhiBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. -- by @K at . - | TmNotBotCt !Id - -- ^ @TmNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. - -instance Outputable TmCt where - ppr (TmVarCt x y) = ppr x <+> char '~' <+> ppr y - ppr (TmCoreCt x e) = ppr x <+> char '~' <+> ppr e - ppr (TmConCt x con tvs args) = ppr x <+> char '~' <+> hsep (ppr con : pp_tvs ++ pp_args) + | PhiNotBotCt !Id + -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. + +instance Outputable PhiCt where + ppr (PhiVarCt x y) = ppr x <+> char '~' <+> ppr y + ppr (PhiCoreCt x e) = ppr x <+> char '~' <+> ppr e + ppr (PhiConCt x con tvs dicts args) = + hsep (ppr con : pp_tvs ++ pp_dicts ++ pp_args) <+> text "<-" <+> ppr x where - pp_tvs = map ((<> char '@') . ppr) tvs - pp_args = map ppr args - ppr (TmNotConCt x con) = ppr x <+> text "≁" <+> ppr con - ppr (TmBotCt x) = ppr x <+> text "~ ⊥" - ppr (TmNotBotCt x) = ppr x <+> text "≁ ⊥" - -type TyCt = PredType - --- | An oracle constraint. -data PmCt - = PmTyCt !TyCt - -- ^ @PmTy pred_ty@ carries 'PredType's, for example equality constraints. - | PmTmCt !TmCt - -- ^ A term constraint. - -type PmCts = Bag PmCt - -pattern PmVarCt :: Id -> Id -> PmCt -pattern PmVarCt x y = PmTmCt (TmVarCt x y) -pattern PmCoreCt :: Id -> CoreExpr -> PmCt -pattern PmCoreCt x e = PmTmCt (TmCoreCt x e) -pattern PmConCt :: Id -> PmAltCon -> [TyVar] -> [Id] -> PmCt -pattern PmConCt x con tvs args = PmTmCt (TmConCt x con tvs args) -pattern PmNotConCt :: Id -> PmAltCon -> PmCt -pattern PmNotConCt x con = PmTmCt (TmNotConCt x con) -pattern PmBotCt :: Id -> PmCt -pattern PmBotCt x = PmTmCt (TmBotCt x) -pattern PmNotBotCt :: Id -> PmCt -pattern PmNotBotCt x = PmTmCt (TmNotBotCt x) -{-# COMPLETE PmTyCt, PmVarCt, PmCoreCt, PmConCt, PmNotConCt, PmBotCt, PmNotBotCt #-} - -instance Outputable PmCt where - ppr (PmTyCt pred_ty) = ppr pred_ty - ppr (PmTmCt tm_ct) = ppr tm_ct + pp_tvs = map ((<> char '@') . ppr) tvs + pp_dicts = map ppr dicts + pp_args = map ppr args + ppr (PhiNotConCt x con) = ppr x <+> text "≁" <+> ppr con + ppr (PhiBotCt x) = ppr x <+> text "~ ⊥" + ppr (PhiNotBotCt x) = ppr x <+> text "≁ ⊥" + +type PhiCts = Bag PhiCt -- | Adds new constraints to 'Nabla' and returns 'Nothing' if that leads to a -- contradiction. -- --- In terms of the paper, this function models the \(⊕_δ\) function in --- Figure 7. -addPmCts :: Nabla -> PmCts -> DsM (Maybe Nabla) +-- In terms of the paper, this function models the \(⊕_φ\) function in +-- Figure 7 on batches of φ constraints. +addPhiCts :: Nabla -> PhiCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. -addPmCts nabla cts = runMaybeT $ do - nabla' <- addPmCtsNoTest nabla cts +addPhiCts nabla cts = runMaybeT $ do + nabla' <- addPhiCtsNoTest nabla cts + -- We need 3 because of T15584 inhabitationTest 3 (nabla_ty_st nabla) nabla' -- Why not always perform the inhabitation test immediately after adding type @@ -920,20 +867,20 @@ addPmCts nabla cts = runMaybeT $ do -- So we perform the inhabitation test once after having added all constraints -- that we wanted to add. --- | Add 'PmCts' ('addPmCts') without performing an inhabitation test by +-- | Add 'PmCts' ('addPhiCts') without performing an inhabitation test by -- instantiation afterwards. Very much for internal use only! -addPmCtsNoTest :: Nabla -> PmCts -> MaybeT DsM Nabla +addPhiCtsNoTest :: Nabla -> PhiCts -> MaybeT DsM Nabla -- See Note [TmState invariants]. -addPmCtsNoTest nabla cts = do - let (ty_cts, tm_cts) = partitionTyTmCts cts +addPhiCtsNoTest nabla cts = do + let (ty_cts, tm_cts) = partitionPhiCts cts nabla' <- addTyCts nabla (listToBag ty_cts) - addTmCts nabla' (listToBag tm_cts) + foldlM addPhiCt nabla' (listToBag tm_cts) -partitionTyTmCts :: PmCts -> ([TyCt], [TmCt]) -partitionTyTmCts = partitionEithers . map to_either . toList +partitionPhiCts :: PhiCts -> ([PredType], [PhiCt]) +partitionPhiCts = partitionEithers . map to_either . toList where - to_either (PmTyCt pred_ty) = Left pred_ty - to_either (PmTmCt tm_ct) = Right tm_ct + to_either (PhiTyCt pred_ty) = Left pred_ty + to_either ct = Right ct -- | Adds new type-level constraints by calling out to the type-checker via -- 'tyOracle'. @@ -942,19 +889,33 @@ addTyCts nabla at MkNabla{ nabla_ty_st = ty_st } new_ty_cs = do ty_st' <- MaybeT (tyOracle ty_st new_ty_cs) pure nabla{ nabla_ty_st = ty_st' } --- | Adds new term constraints by adding them one by one. -addTmCts :: Nabla -> Bag TmCt -> MaybeT DsM Nabla -addTmCts nabla new_tm_cs = foldlM addTmCt nabla new_tm_cs - --- | Adds a single term constraint by dispatching to the various term oracle --- functions. -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 a single higher-level φ constraint by dispatching to the various +-- oracle functions. +-- +-- In terms of the paper, this function amounts to the constructor constraint +-- case of \(⊕_φ\) in Figure 7, which "desugars" higher-level φ constraints +-- into lower-level δ constraints. We don't have a data type for δ constraints +-- and call the corresponding oracle function directly instead. +-- +-- Precondition: The φ is not a type constraint! These should be handled by +-- 'addTyCts' before, through 'addPhiCts'. +addPhiCt :: Nabla -> PhiCt -> MaybeT DsM Nabla +addPhiCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition +addPhiCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiCt nabla (PhiConCt x con tvs dicts args) = do + -- PhiConCt correspond to the higher-level φ constraints from the paper with + -- bindings semantics. It disperses into lower-level δ constraints that the + -- 'add*Ct' functions correspond to. + nabla' <- addTyCts nabla (listToBag dicts) + nabla'' <- addConCt nabla' x con tvs args + let unlifted_fields = + [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || isUnliftedType (idType arg) ] + foldlM addNotBotCt nabla'' unlifted_fields +addPhiCt nabla (PhiVarCt x y) = addVarCt nabla x y +addPhiCt nabla (PhiNotConCt x con) = addNotConCt nabla x con +addPhiCt nabla (PhiBotCt x) = addBotCt nabla x +addPhiCt nabla (PhiNotBotCt x) = addNotBotCt nabla x -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about @@ -974,32 +935,32 @@ addBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- that leads to a contradiction. -- See Note [TmState invariants]. addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla -addNotConCt _ _ (PmAltConLike (RealDataCon dc)) +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 - let vi@(VI _ pos neg _ rcm _) = lookupVarInfo ts x - -- 1. Bail out quickly when nalt contradicts a solution - let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal - guard (not (any (contradicts nalt) pos)) - -- 2. Only record the new fact when it's not already implied by one of the - -- solutions - let implies nalt sol = eqPmAltCon (paca_con sol) nalt == Disjoint - let neg' - | any (implies nalt) pos = neg - -- See Note [Completeness checking with required Thetas] - | hasRequiredTheta nalt = neg - | otherwise = extendPmAltConSet neg nalt - MASSERT( isPmAltConMatchStrict nalt ) - 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 -> do - -- Mark dirty to force a delayed inhabitation test - rcm' <- lift (markMatched cl rcm) - pure vi1{ vi_rcm = rcm', vi_dirty = True } - _ -> - pure vi1 - pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } +addNotConCt nabla x nalt = overVarInfo go nabla x + where + go vi@(VI _ pos neg _ rcm _) = do + -- 1. Bail out quickly when nalt contradicts a solution + let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal + guard (not (any (contradicts nalt) pos)) + -- 2. Only record the new fact when it's not already implied by one of the + -- solutions + let implies nalt sol = eqPmAltCon (paca_con sol) nalt == Disjoint + let neg' + | any (implies nalt) pos = neg + -- See Note [Completeness checking with required Thetas] + | hasRequiredTheta nalt = neg + | otherwise = extendPmAltConSet neg nalt + MASSERT( isPmAltConMatchStrict nalt ) + let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } + -- 3. Make sure there's at least one other possible constructor + case nalt of + PmAltConLike cl -> do + -- Mark dirty to force a delayed inhabitation test + rcm' <- lift (markMatched cl rcm) + pure vi1{ vi_rcm = rcm', vi_dirty = True } + _ -> + pure vi1 hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -1100,7 +1061,7 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = TmSt env reps} = d lift (varNeedsTesting old_ty_st (nabla_ty_st nabla) vi) >>= \case True | null (vi_pos vi) -> do -- No solution yet and needs testing - lift $ tracePm "instantiate one" (ppr vi) + trcM "instantiate one" (ppr vi) instantiate (fuel-1) nabla vi _ -> pure vi @@ -1113,9 +1074,6 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = TmSt env reps} = d -- to test if unchanged. -- 4. If all the constructors of a TyCon are vanilla, we don't have to test. -- "vanilla" = No strict fields and no Theta. --- It doesn't need to if it isn't marked dirty because of new negative type --- constraints /and/ its representation type didn't change compared to the old --- 'TyState' from the last inhabitation test. varNeedsTesting :: TyState -> TyState -> VarInfo -> DsM Bool varNeedsTesting _ _ vi | vi_dirty vi = pure True @@ -1156,20 +1114,19 @@ instBot _fuel nabla vi = do _nabla' <- addBotCt nabla (vi_id vi) pure vi -overVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -overVarInfo f nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x +trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x = set_vi <$> f (lookupVarInfo ts x) where set_vi (a, vi') = (a, nabla{ nabla_tm_st = TmSt (setEntrySDIE env (vi_id vi') vi') reps }) -modifyVarInfo :: (VarInfo -> VarInfo) -> Nabla -> Id -> Nabla -modifyVarInfo f nabla x = runIdentity $ - snd <$> overVarInfo (\vi -> pure ((), f vi)) nabla x +overVarInfo :: Functor f => (VarInfo -> f VarInfo) -> Nabla -> Id -> f Nabla +overVarInfo f nabla x = snd <$> trvVarInfo (\vi -> ((),) <$> f vi) nabla x addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = overVarInfo add_matches nabla x + = trvVarInfo add_matches nabla x where add_matches vi at VI{ vi_rcm = rcm } = do res <- pmTopNormaliseType ty_st (idType x) @@ -1205,8 +1162,8 @@ anyConLikeSolution p = any (go . paca_con) go _ = False instCompleteSet :: Int -> Nabla -> Id -> ConLikeSet -> MaybeT DsM Nabla --- (instCompleteSet nabla vi cs cls) iterates over cls, deleting from cs --- any uninhabited elements of cls. Stop (returning Just (nabla', cs)) +-- (instCompleteSet nabla vi cs) iterates over cs, deleting from cs +-- any uninhabited elements. Stop (returning (Just nabla')) -- when you see an inhabited element; return Nothing if all are uninhabited instCompleteSet fuel nabla x cs | anyConLikeSolution (`elementOfUniqDSet` cs) (vi_pos vi) @@ -1235,73 +1192,6 @@ instCompleteSet fuel nabla x cs nabla' <- addNotConCt nabla x (PmAltConLike con) go nabla' cons - --- | 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_rcm. --- --- 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 (add_matches vi) >>= inst_complete_sets - where - add_matches :: VarInfo -> DsM VarInfo - add_matches vi = do - res <- pmTopNormaliseType (nabla_ty_st nabla) (idType (vi_id 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_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 - -- any uninhabited elements of cls. Stop (returning Just cs) - -- when you see an inhabited element; return Nothing if all - -- are uninhabited - inst_complete_set _ _ [] = mzero - inst_complete_set vi cs (con:cons) = lift (inst_and_test vi con) >>= \case - True -> pure cs - False -> inst_complete_set vi (delOneFromUniqDSet cs con) cons - - 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 Nabla into account. - inst_and_test vi con = isJust <$> mkOneConFull nabla (vi_id vi) con - --- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- '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 -> MaybeT DsM Nabla -ensureAllInhabited nabla at MkNabla{ nabla_tm_st = TmSt env reps } = do - env' <- traverseSDIE (ensureInhabited nabla) env - pure nabla{ nabla_tm_st = TmSt env' reps } - -------------------------------------- -- * Term oracle unification procedure @@ -1378,8 +1268,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) 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 - addPmCtsNoTest nabla (listToBag ty_cts `unionBags` listToBag tm_cts) + let tm_cts = zipWithEqual "addConCt" (\a b -> PhiCoreCt a (Var b)) args other_args + addPhiCtsNoTest nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = @@ -1394,101 +1284,15 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do _ -> ASSERT( isPmAltConMatchStrict alt ) pure (nabla_with IsNotBot) -- strict match ==> not ⊥ -equateTys :: [Type] -> [Type] -> [PmCt] +equateTys :: [Type] -> [Type] -> [PhiCt] equateTys ts us = - [ PmTyCt (mkPrimEqPred t u) + [ PhiTyCt (mkPrimEqPred t u) | (t, u) <- zipEqual "equateTys" ts us -- The following line filters out trivial Refl constraints, so that we don't -- need to initialise the type oracle that often , not (eqType t u) ] ----------------------------------------- --- * Enumerating inhabitation candidates - --- | Information about a conlike that is relevant to coverage checking. --- It is called an \"inhabitation candidate\" since it is a value which may --- possibly inhabit some type, but only if its term constraints ('ic_tm_cs') --- and type constraints ('ic_ty_cs') are permitting, and if all of its strict --- argument types ('ic_strict_arg_tys') are inhabitable. --- See @Note [Strict argument type constraints]@. --- data InhabitationCandidate = --- InhabitationCandidate --- { ic_cs :: PmCts --- , ic_strict_arg_tys :: [Type] --- } --- --- instance Outputable InhabitationCandidate where --- ppr (InhabitationCandidate cs strict_arg_tys) = --- text "InhabitationCandidate" <+> --- vcat [ text "ic_cs =" <+> ppr cs --- , text "ic_strict_arg_tys =" <+> ppr strict_arg_tys ] --- --- mkInhabitationCandidate :: Id -> DataCon -> DsM InhabitationCandidate --- -- Precondition: idType x is a TyConApp, so that tyConAppArgs in here is safe. --- mkInhabitationCandidate x dc = do --- let cl = RealDataCon dc --- let tc_args = tyConAppArgs (idType x) --- (ty_vars, arg_vars, ty_cs, strict_arg_tys) <- mkOneConFull tc_args cl --- pure InhabitationCandidate --- { ic_cs = PmTyCt <$> ty_cs `snocBag` PmConCt x (PmAltConLike cl) ty_vars arg_vars --- , ic_strict_arg_tys = strict_arg_tys --- } --- --- -- | Generate all 'InhabitationCandidate's for a given type. The result is --- -- either @'Left' ty@, if the type cannot be reduced to a closed algebraic type --- -- (or if it's one trivially inhabited, like 'Int'), or @'Right' candidates@, --- -- 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 :: Nabla -> Type --- -> DsM (Either Type (TyCon, Id, [InhabitationCandidate])) --- 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' [] --- HadRedexes src_ty dcs core_ty -> alts_to_check src_ty core_ty dcs --- where --- build_newtype :: (Type, DataCon, Type) -> Id -> DsM (Id, PmCt) --- build_newtype (ty, dc, _arg_ty) x = do --- -- ty is the type of @dc x at . It's a @dataConTyCon dc@ application. --- y <- mkPmId ty --- -- Newtypes don't have existentials (yet?!), so passing an empty list as --- -- ex_tvs. --- pure (y, PmConCt y (PmAltConLike (RealDataCon dc)) [] [x]) --- --- build_newtypes :: Id -> [(Type, DataCon, Type)] -> DsM (Id, [PmCt]) --- build_newtypes x = foldrM (\dc (x, cts) -> go dc x cts) (x, []) --- where --- go dc x cts = second (:cts) <$> build_newtype dc x --- --- -- Inhabitation candidates, using the result of pmTopNormaliseType --- alts_to_check :: Type -> Type -> [(Type, DataCon, Type)] --- -> DsM (Either Type (TyCon, Id, [InhabitationCandidate])) --- alts_to_check src_ty core_ty dcs = case splitTyConApp_maybe core_ty of --- Just (tc, _) --- | isTyConTriviallyInhabited tc --- -> case dcs of --- [] -> return (Left src_ty) --- (_:_) -> do inner <- mkPmId core_ty --- (outer, new_tm_cts) <- build_newtypes inner dcs --- return $ Right (tc, outer, [InhabitationCandidate --- { ic_cs = listToBag new_tm_cts --- , ic_strict_arg_tys = [] }]) --- --- | pmIsClosedType core_ty && not (isAbstractTyCon tc) --- -- Don't consider abstract tycons since we don't know what their --- -- constructors are, which makes the results of coverage checking --- -- them extremely misleading. --- -> do --- inner <- mkPmId core_ty -- it would be wrong to unify inner --- (outer, new_cts) <- build_newtypes inner dcs --- alts <- mapM (mkInhabitationCandidate inner) (tyConDataCons tc) --- let wrap_dcs alt = alt{ ic_cs = listToBag new_cts `unionBags` ic_cs alt} --- return $ Right (tc, outer, map wrap_dcs alts) --- -- For other types conservatively assume that they are inhabited. --- _other -> return (Left src_ty) - -- | All these types are trivially inhabited triviallyInhabitedTyCons :: UniqSet TyCon triviallyInhabitedTyCons = mkUniqSet [ @@ -1600,32 +1404,13 @@ we do the following: -- cand_is_inhabitable rec_ts amb_cs -- (InhabitationCandidate{ ic_cs = new_cs -- , ic_strict_arg_tys = new_strict_arg_tys }) = do --- let (new_ty_cs, new_tm_cs) = partitionTyTmCts new_cs +-- let (new_ty_cs, new_tm_cs) = partitionPhiCts new_cs -- fmap isJust $ runSatisfiabilityCheck amb_cs $ mconcat -- [ addTyCts False (listToBag new_ty_cs) --- , addTmCts (listToBag new_tm_cs) +-- , addPhiCts (listToBag new_tm_cs) -- , tysAreNonVoid rec_ts new_strict_arg_tys -- ] --- | @'definitelyInhabitedType' ty@ returns 'True' if @ty@ has at least one --- constructor @C@ such that: --- --- 1. @C@ has no equality constraints. --- 2. @C@ has no strict argument types. --- --- See the @Note [Strict argument type constraints]@. -definitelyInhabitedType :: TyState -> Type -> DsM Bool -definitelyInhabitedType ty_st ty = do - res <- pmTopNormaliseType ty_st ty - pure $ case res of - HadRedexes _ cons _ -> any meets_criteria cons - _ -> False - where - meets_criteria :: (Type, DataCon, Type) -> Bool - meets_criteria (_, con, _) = - null (dataConEqSpec con) && -- (1) - null (dataConImplBangs con) -- (2) - {- Note [Strict argument type constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally @@ -1957,6 +1742,9 @@ addCoreCt nabla x e = do core_expr x (Cast e _co) = core_expr x e core_expr x (Tick _t e) = core_expr x e core_expr x e + | Var y <- e, Nothing <- isDataConId_maybe x + -- We don't consider DataCons flexible variables + = modifyT (\nabla -> addVarCt nabla x y) | Just (pmLitAsStringLit -> Just s) <- coreExprAsPmLit e , expr_ty `eqType` stringTy -- See Note [Representation of Strings in TmState] @@ -2024,7 +1812,7 @@ addCoreCt nabla x e = do 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 -> addPmCtsNoTest nabla (listToBag ty_cts) + modifyT $ \nabla -> addPhiCtsNoTest nabla (listToBag ty_cts) -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ arg_ids <- traverse bind_expr vis_args -- 4. @x ~ K as ys@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8c2cafeed7c75f98b740cfcf23431c296862893 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8c2cafeed7c75f98b740cfcf23431c296862893 You're receiving 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 15 14:13:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Sep 2020 10:13:58 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f60cc26c8224_80b3f849cb8ff28122084fd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 9b999fe8 by Ben Gamari at 2020-09-15T10:13:51-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + struct ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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->foreign_exports; + cur->oc->foreign_exports = 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_ptrs = NULL; } static void @@ -1404,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b999fe8bdeb5a624e54ccb8249072490e5a42f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b999fe8bdeb5a624e54ccb8249072490e5a42f0 You're receiving 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 15 15:45:42 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 15 Sep 2020 11:45:42 -0400 Subject: [Git][ghc/ghc][wip/T18249] Pass validation build Message-ID: <5f60e1a64ecb1_80b3f84a007c3bc1221462e@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: c4940e78 by Sebastian Graf at 2020-09-15T17:45:35+02:00 Pass validation build - - - - - 4 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Gen/Expr.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,7 +1347,8 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a -#if __GLASGOW_HASKELL__ <= 900 +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True #endif ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -230,7 +230,7 @@ applies due to refined type information. -- existential and term binders with fresh variables of appropriate type. -- Returns instantiated type and term variables from the match, type evidence -- and the types of strict constructor fields. -mkOneConFull :: Nabla -> Id -> ConLike -> DsM (Maybe Nabla) +instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla -- * 'con' K is a ConLike -- - In the case of DataCons and most PatSynCons, these -- are associated with a particular TyCon T @@ -252,7 +252,7 @@ mkOneConFull :: Nabla -> Id -> ConLike -> DsM (Maybe Nabla) -- [y1,..,yn] -- Q -- [s1] -mkOneConFull nabla at MkNabla{nabla_ty_st = ty_st} x con = do +instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do env <- dsGetFamInstEnvs src_ty <- normalisedSourceType <$> pmTopNormaliseType ty_st (idType x) let mb_arg_tys = guessConLikeUnivTyArgsFromResTy env src_ty con @@ -272,15 +272,16 @@ mkOneConFull nabla at MkNabla{nabla_ty_st = ty_st} x con = do -- to the type oracle let gammas = substTheta subst (eqSpecPreds eq_spec ++ thetas) -- Finally add everything to nabla - tracePm "mkOneConFull" $ vcat + tracePm "instCon" $ vcat [ ppr x <+> dcolon <+> ppr (idType x) , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (zipWith (\tv ty -> ppr tv <+> char '↦' <+> ppr ty) univ_tvs arg_tys) , ppr gammas , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) ] - -- Note that we add a - runMaybeT $ addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) + runMaybeT $ do + nabla' <- addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) + inhabitationTest fuel (nabla_ty_st nabla) nabla' Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited {- Note [Strict fields and variables of unlifted type] @@ -311,7 +312,7 @@ since the forcing happens *before* pattern matching. expected. 2. Similarly, when performing the inhabitation test ('ensureInhabited'), - when instantiating a constructor in 'mkOneConFull', we have to generate + when instantiating a constructor in 'instCon', we have to generate the appropriate unliftedness constraints and hence call 'phiConCts'. 3. TODO @@ -586,10 +587,10 @@ tyOracle ty_st@(TySt inert) cts = pure (Just ty_st) | otherwise = do { evs <- traverse nameTyCt cts - ; tracePm "tyOracle" (ppr cts) + ; tracePm "tyOracle" (ppr cts $$ ppr inert) ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just mb_new_inert -> return (TySt <$> mb_new_inert) + Just mb_new_inert -> tracePm "res" (ppr mb_new_inert) >> return (TySt <$> mb_new_inert) Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } {- ********************************************************************* @@ -799,15 +800,14 @@ lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of | Just sol <- find isDataConSolution pos -> Just sol | otherwise -> Just (head pos) -------------------------------- --- * Adding facts to the oracle +------------------------- +-- * Adding φ constraints --- | A term constraint. +-- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of +-- the LYG paper. data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". - | PhiVarCt !Id !Id - -- ^ @PhiVarCt x y@ encodes "x ~ y", equating @x@ and @y at . | PhiCoreCt !Id !CoreExpr -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] @@ -825,7 +825,7 @@ data PhiCt -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. instance Outputable PhiCt where - ppr (PhiVarCt x y) = ppr x <+> char '~' <+> ppr y + ppr (PhiTyCt ty_ct) = ppr ty_ct ppr (PhiCoreCt x e) = ppr x <+> char '~' <+> ppr e ppr (PhiConCt x con tvs dicts args) = hsep (ppr con : pp_tvs ++ pp_dicts ++ pp_args) <+> text "<-" <+> ppr x @@ -912,7 +912,6 @@ addPhiCt nabla (PhiConCt x con tvs dicts args) = do [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) , isBanged bang || isUnliftedType (idType arg) ] foldlM addNotBotCt nabla'' unlifted_fields -addPhiCt nabla (PhiVarCt x y) = addVarCt nabla x y addPhiCt nabla (PhiNotConCt x con) = addNotConCt nabla x con addPhiCt nabla (PhiBotCt x) = addBotCt nabla x addPhiCt nabla (PhiNotBotCt x) = addNotBotCt nabla x @@ -1152,8 +1151,8 @@ instCompleteSets :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo instCompleteSets fuel nabla vi = do let x = vi_id vi (rcm, nabla') <- lift (addNormalisedTypeMatches nabla x) - nabla' <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla' (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla') x) + nabla'' <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla' (getRcm rcm) + pure (lookupVarInfo (nabla_tm_st nabla'') x) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1179,18 +1178,15 @@ instCompleteSet fuel nabla x cs go _ [] = mzero go nabla (con:cons) = do let x = vi_id vi - lift (mkOneConFull nabla x con) >>= \case - Just nabla' -> do - lift $ tracePm "blah" (ppr x $$ ppr con $$ ppr nabla') - _nabla' <- inhabitationTest fuel (nabla_ty_st nabla) nabla' - -- nabla' is inhabited, which is what we were trying to prove. But - -- nabla' is also a possibly proper subset of nabla, so we have to - -- return the old nabla and lose all the work we did. - pure nabla - Nothing -> do - -- We just proved that x can't be con. Encode that fact with addNotConCt. - nabla' <- addNotConCt nabla x (PmAltConLike con) - go nabla' cons + let recur_not_con = do + nabla' <- addNotConCt nabla x (PmAltConLike con) + go nabla' cons + (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the + -- refined one! + <|> recur_not_con -- Assume that x can't be con. Encode that fact + -- with addNotConCt and recur. + + -------------------------------------- -- * Term oracle unification procedure @@ -1268,7 +1264,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) - let tm_cts = zipWithEqual "addConCt" (\a b -> PhiCoreCt a (Var b)) args other_args + let phi_var_ct a b = PhiCoreCt a (Var b) + let tm_cts = zipWithEqual "addConCt" phi_var_ct args other_args addPhiCtsNoTest nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = PACA alt tvs args : pos @@ -1666,30 +1663,23 @@ generateInhabitants (x:xs) n nabla = do | fmap (isTyConTriviallyInhabited . fst) (splitTyConApp_maybe ty) == Just True = generateInhabitants xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do - env <- dsGetFamInstEnvs - case guessConLikeUnivTyArgsFromResTy env ty cl of - -- Nothing should never happen! This ConLikeSet should have been - -- filtered earlier by pickApplicableCompleteSets. - Nothing -> pprPanic "instantiate_cons" (ppr ty $$ ppr cl) - Just arg_tys -> do - mb_nabla <- mkOneConFull nabla x cl - -- Now check satifiability - tracePm "instantiate_cons" (vcat [ ppr x - , ppr (idType x) - , ppr ty - , ppr cl - , ppr arg_tys - , ppr nabla - , ppr mb_nabla - , ppr n ]) - 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 the inhabitation test would have refuted. - Just nabla' -> generateInhabitants xs n nabla' - other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls - pure (con_nablas ++ other_cons_nablas) + mb_nabla <- runMaybeT $ instCon 3 nabla x cl + tracePm "instantiate_cons" (vcat [ ppr x + , ppr (idType x) + , ppr ty + , ppr cl + , ppr nabla + , ppr mb_nabla + , ppr n ]) + + 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 the inhabitation test would have refuted. + Just nabla' -> generateInhabitants xs n nabla' + other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls + pure (con_nablas ++ other_cons_nablas) pickApplicableCompleteSets :: Type -> ResidualCompleteMatches -> DsM [ConLikeSet] pickApplicableCompleteSets ty rcm = do @@ -1759,9 +1749,6 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe x - -- We don't consider DataCons flexible variables - = 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! ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -609,9 +609,13 @@ instance Outputable TmState where -- | Not user-facing. instance Outputable VarInfo where ppr (VI x pos neg bot cache dirty) - = braces (hcat (punctuate comma [pp_x, ppr pos, ppr neg, ppr bot, ppr cache, pp_dirty])) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache, pp_dirty])) where pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg = char '≁' <> ppr neg pp_dirty | dirty = text "dirty" | otherwise = empty ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,8 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w -#if __GLASGOW_HASKELL__ <= 900 +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4940e78fdfe7fdcef8500033930c5a8fd5e3755 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4940e78fdfe7fdcef8500033930c5a8fd5e3755 You're receiving 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 15 16:12:02 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 15 Sep 2020 12:12:02 -0400 Subject: [Git][ghc/ghc][wip/T18249] More fixes Message-ID: <5f60e7d248ce8_80b8e841dc12218347@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 6d7ea3b3 by Sebastian Graf at 2020-09-15T18:11:56+02:00 More fixes - - - - - 1 changed file: - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -839,6 +839,11 @@ instance Outputable PhiCt where type PhiCts = Bag PhiCt +-- | The fuel for the inhabitation test. +-- See Note [Fuel for the inhabitation test]. +initFuel :: Int +initFuel = 4 -- 4 because it's the smallest number that passes f' in T17977b + -- | Adds new constraints to 'Nabla' and returns 'Nothing' if that leads to a -- contradiction. -- @@ -848,8 +853,7 @@ addPhiCts :: Nabla -> PhiCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. addPhiCts nabla cts = runMaybeT $ do nabla' <- addPhiCtsNoTest nabla cts - -- We need 3 because of T15584 - inhabitationTest 3 (nabla_ty_st nabla) nabla' + inhabitationTest initFuel (nabla_ty_st nabla) nabla' -- Why not always perform the inhabitation test immediately after adding type -- info? Because of infinite loops. Consider @@ -1264,9 +1268,9 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) - let phi_var_ct a b = PhiCoreCt a (Var b) - let tm_cts = zipWithEqual "addConCt" phi_var_ct args other_args - addPhiCtsNoTest nabla (listToBag ty_cts `unionBags` listToBag tm_cts) + nabla' <- addPhiCtsNoTest nabla (listToBag ty_cts) + let add_var_ct nabla (a, b) = addVarCt nabla a b + foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = @@ -1338,76 +1342,6 @@ we do the following: pattern match checking. -} --- -- | A 'SatisfiabilityCheck' based on "NonVoid ty" constraints, e.g. Will --- -- check if the @strict_arg_tys@ are actually all inhabited. --- -- 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 $ \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 nabla --- else Nothing --- --- -- | Implements two performance optimizations, as described in --- -- @Note [Strict argument type constraints]@. --- checkAllNonVoid :: RecTcChecker -> Nabla -> [Type] -> DsM Bool --- checkAllNonVoid rec_ts amb_cs strict_arg_tys = do --- 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 --- = 1 --- | otherwise --- = 3 --- rec_ts' = setRecTcMaxBound rec_max_bound rec_ts --- allM (nonVoid rec_ts' amb_cs) tys_to_check --- --- -- | Checks if a strict argument type of a conlike is inhabitable by a --- -- terminating value (i.e, an 'InhabitationCandidate'). --- -- See @Note [Strict argument type constraints]@. --- nonVoid --- :: RecTcChecker -- ^ The per-'TyCon' recursion depth limit. --- -> 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 --- -- a terminating value (i.e., an 'InhabitationCandidate'). --- -- 'False' if it is definitely uninhabitable by anything --- -- (except bottom). --- nonVoid rec_ts amb_cs strict_arg_ty = do --- mb_cands <- inhabitationCandidates amb_cs strict_arg_ty --- case mb_cands of --- Right (tc, _, cands) --- -- See Note [Fuel for the inhabitation test] --- | Just rec_ts' <- checkRecTc rec_ts tc --- -> anyM (cand_is_inhabitable rec_ts' amb_cs) cands --- -- A strict argument type is inhabitable by a terminating value if --- -- at least one InhabitationCandidate is inhabitable. --- _ -> pure True --- -- Either the type is trivially inhabited or we have exceeded the --- -- recursion depth for some TyCon (so bail out and conservatively --- -- claim the type is inhabited). --- where --- -- Checks if an InhabitationCandidate for a strict argument type: --- -- --- -- (1) Has satisfiable term and type constraints. --- -- (2) Has 'nonVoid' strict argument types (we bail out of this --- -- check if recursion is detected). --- -- --- -- See Note [Strict argument type constraints] --- cand_is_inhabitable :: RecTcChecker -> Nabla --- -> InhabitationCandidate -> DsM Bool --- cand_is_inhabitable rec_ts amb_cs --- (InhabitationCandidate{ ic_cs = new_cs --- , ic_strict_arg_tys = new_strict_arg_tys }) = do --- let (new_ty_cs, new_tm_cs) = partitionPhiCts new_cs --- fmap isJust $ runSatisfiabilityCheck amb_cs $ mconcat --- [ addTyCts False (listToBag new_ty_cs) --- , addPhiCts (listToBag new_tm_cs) --- , tysAreNonVoid rec_ts new_strict_arg_tys --- ] - {- Note [Strict argument type constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the ConVar case of clause processing, each conlike K traditionally @@ -1473,8 +1407,8 @@ We call this the "inhabitation test". Note [Fuel for the inhabitation test] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Whether or not a type is inhabited is undecidable in general. As a result, we -can run into infinite loops in `nonVoid`. Therefore, we adopt a fuel-based -approach to prevent that. +can run into infinite loops in `inhabitationTest`. Therefore, we adopt a +fuel-based approach to prevent that. Consider the following example: @@ -1483,12 +1417,12 @@ Consider the following example: stareIntoTheAbyss x = case x of {} In principle, stareIntoTheAbyss is exhaustive, since there is no way to -construct a terminating value using MkAbyss. However, both the term and type -constraints for MkAbyss are satisfiable, so the only way one could determine -that MkAbyss is unreachable is to check if `nonVoid Abyss` returns False. -There is only one InhabitationCandidate for Abyss—MkAbyss—and both its term -and type constraints are satisfiable, so we'd need to check if `nonVoid Abyss` -returns False... and now we've entered an infinite loop! +construct a terminating value using MkAbyss. But this can't be proven by mere +instantiation and requires an inductive argument, which `inhabitationTest` +currently isn't equipped to do. + +In order to prevent endless instantiation attempts in @inhabitationTest@, we use +the fuel as an upper bound such attempts. To avoid this sort of conundrum, `nonVoid` uses a simple test to detect the presence of recursive types (through `checkRecTc`), and if recursion is @@ -1663,7 +1597,7 @@ generateInhabitants (x:xs) n nabla = do | fmap (isTyConTriviallyInhabited . fst) (splitTyConApp_maybe ty) == Just True = generateInhabitants xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do - mb_nabla <- runMaybeT $ instCon 3 nabla x cl + mb_nabla <- runMaybeT $ instCon 4 nabla x cl tracePm "instantiate_cons" (vcat [ ppr x , ppr (idType x) , ppr ty @@ -1718,7 +1652,7 @@ 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') + 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 @@ -1732,9 +1666,6 @@ addCoreCt nabla x e = do core_expr x (Cast e _co) = core_expr x e core_expr x (Tick _t e) = core_expr x e core_expr x e - | Var y <- e, Nothing <- isDataConId_maybe x - -- We don't consider DataCons flexible variables - = modifyT (\nabla -> addVarCt nabla x y) | Just (pmLitAsStringLit -> Just s) <- coreExprAsPmLit e , expr_ty `eqType` stringTy -- See Note [Representation of Strings in TmState] @@ -1749,6 +1680,9 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args -- See Note [Detecting pattern synonym applications in expressions] + | Var y <- e, Nothing <- isDataConId_maybe x + -- We don't consider DataCons flexible variables + = 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! View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d7ea3b343e838daaf0ff930ef9ffbf3f1cc7367 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d7ea3b343e838daaf0ff930ef9ffbf3f1cc7367 You're receiving 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 15 16:53:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 15 Sep 2020 12:53:09 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 21 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f60f175597f3_80b4313298122272da@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - e1bbedc5 by Ben Gamari at 2020-09-15T12:52:23-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 97d8fe5a by Ben Gamari at 2020-09-15T12:52:54-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 20bc4ea4 by Ben Gamari at 2020-09-15T12:53:03-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 16 changed files: - .gitignore - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.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/b0ac687586ad124d0835a671ce15a09f5ca4cbef...20bc4ea42d446062f67b5777b87baa7da7c1e91c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0ac687586ad124d0835a671ce15a09f5ca4cbef...20bc4ea42d446062f67b5777b87baa7da7c1e91c You're receiving 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 15 17:00:32 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 15 Sep 2020 13:00:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/no-at-unpack Message-ID: <5f60f33067cec_80b3f84960edf44122278a1@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/no-at-unpack at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-at-unpack You're receiving 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 15 19:19:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:19:16 -0400 Subject: [Git][ghc/ghc][master] Fix rtsopts documentation Message-ID: <5f6113b46c20_80b3f8487070b98122612da@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -1028,7 +1028,7 @@ for example). This option affects the processing of RTS control options given either on the command line or via the :envvar:`GHCRTS` environment - variable. There are three possibilities: + variable. There are five possibilities: ``-rtsopts=none`` Disable all processing of RTS options. If ``+RTS`` appears View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8610bcbeb11b898f85f228b755fa8421b5ae3e34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8610bcbeb11b898f85f228b755fa8421b5ae3e34 You're receiving 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 15 19:19:54 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:19:54 -0400 Subject: [Git][ghc/ghc][master] Care with implicit-parameter superclasses Message-ID: <5f6113da3e973_80b3f84919d58141226514@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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 ===================================== @@ -1374,7 +1374,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/c7182a5c67fe8b5bd256cb8eb805562636853ea2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7182a5c67fe8b5bd256cb8eb805562636853ea2 You're receiving 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 15 19:20:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:20:31 -0400 Subject: [Git][ghc/ghc][master] Export enrichHie from GHC.Iface.Ext.Ast Message-ID: <5f6113ff365cd_80b3f8494d1b6b0122687e8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - 1 changed file: - compiler/GHC/Iface/Ext/Ast.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f3884b0b72fb1e4641450e68f63580c0e86f515 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f3884b0b72fb1e4641450e68f63580c0e86f515 You're receiving 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 15 19:21:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:21:13 -0400 Subject: [Git][ghc/ghc][master] Enhance metrics output Message-ID: <5f61142915225_80b3f848cd44d1012271310@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 2 changed files: - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -108,12 +108,12 @@ class MetricChange(Enum): } return strings[self] - def short_name(self): + def hint(self): strings = { - MetricChange.NewMetric: "new", - MetricChange.NoChange: "unch", - MetricChange.Increase: "incr", - MetricChange.Decrease: "decr" + MetricChange.NewMetric: colored(Color.BLUE,"NEW"), + MetricChange.NoChange: "", + MetricChange.Increase: colored(Color.RED, "BAD"), + MetricChange.Decrease: colored(Color.GREEN,"GOOD") } return strings[self] ===================================== testsuite/driver/runtests.py ===================================== @@ -348,21 +348,21 @@ def tabulate_metrics(metrics: List[PerfMetric]) -> None: 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]: + def row(cells: Tuple[str, 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")) + 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) + return "{:+2.1f}%".format(100 * (val1 - val0) / val0) dataRows = [row(( "{}({})".format(x.stat.test, x.stat.way), shorten_metric_name(x.stat.metric), @@ -374,7 +374,8 @@ def tabulate_metrics(metrics: List[PerfMetric]) -> None: "{:13.1f}".format(x.baseline.perfStat.value) if x.baseline is not None else "", "{:13.1f}".format(x.stat.value), - strDiff(x) + strDiff(x), + "{}".format(x.change.hint()) )) for x in sorted(metrics, key = lambda m: (m.stat.test, m.stat.way, m.stat.metric))] print_table(headerRows, dataRows, 1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3143f5a0827b640840ef241a30933dc23b69d91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3143f5a0827b640840ef241a30933dc23b69d91 You're receiving 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 15 19:21:44 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 15 Sep 2020 15:21:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/doc-iface-tuple-ty Message-ID: <5f611448c546d_80b3f8487070b9812272791@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/doc-iface-tuple-ty at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/doc-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 Tue Sep 15 19:21:53 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:21:53 -0400 Subject: [Git][ghc/ghc][master] Introduce and use DerivClauseTys (#18662) Message-ID: <5f6114512a9ca_80b3f848cd44d10122764d5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 11 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/ThToHs.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -25,7 +25,8 @@ module GHC.Hs.Decls ( -- * Toplevel declarations HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, - HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour, + HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, + NewOrData(..), newOrDataToFlavour, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, -- ** Class or type declarations @@ -1321,15 +1322,8 @@ data HsDerivingClause pass , deriv_clause_strategy :: Maybe (LDerivStrategy pass) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. - , deriv_clause_tys :: XRec pass [LHsSigType pass] + , deriv_clause_tys :: LDerivClauseTys pass -- ^ The types to derive. - -- - -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@, - -- we can mention type variables that aren't bound by the datatype, e.g. - -- - -- > data T b = ... deriving (C [a]) - -- - -- should produce a derived instance for @C [a] (T b)@. } | XHsDerivingClause !(XXHsDerivingClause pass) @@ -1342,16 +1336,9 @@ instance OutputableBndrId p , deriv_clause_tys = L _ dct }) = hsep [ text "deriving" , pp_strat_before - , pp_dct dct + , ppr dct , pp_strat_after ] where - -- This complexity is to distinguish between - -- deriving Show - -- deriving (Show) - pp_dct [HsIB { hsib_body = ty }] - = ppr (parenthesizeHsType appPrec ty) - pp_dct _ = parens (interpp'SP dct) - -- @via@ is unique in that in comes /after/ the class being derived, -- so we must special-case it. (pp_strat_before, pp_strat_after) = @@ -1359,6 +1346,43 @@ instance OutputableBndrId p Just (L _ via at ViaStrategy{}) -> (empty, ppr via) _ -> (ppDerivStrategy dcs, empty) +type LDerivClauseTys pass = XRec pass (DerivClauseTys pass) + +-- | The types mentioned in a single @deriving@ clause. This can come in two +-- forms, 'DctSingle' or 'DctMulti', depending on whether the types are +-- surrounded by enclosing parentheses or not. These parentheses are +-- semantically differnt than 'HsParTy'. For example, @deriving ()@ means +-- \"derive zero classes\" rather than \"derive an instance of the 0-tuple\". +-- +-- 'DerivClauseTys' use 'LHsSigType' because @deriving@ clauses can mention +-- type variables that aren't bound by the datatype, e.g. +-- +-- > data T b = ... deriving (C [a]) +-- +-- should produce a derived instance for @C [a] (T b)@. +data DerivClauseTys pass + = -- | A @deriving@ clause with a single type. Moreover, that type can only + -- be a type constructor without any arguments. + -- + -- Example: @deriving Eq@ + DctSingle (XDctSingle pass) (LHsSigType pass) + + -- | A @deriving@ clause with a comma-separated list of types, surrounded + -- by enclosing parentheses. + -- + -- Example: @deriving (Eq, C a)@ + | DctMulti (XDctMulti pass) [LHsSigType pass] + + | XDerivClauseTys !(XXDerivClauseTys pass) + +type instance XDctSingle (GhcPass _) = NoExtField +type instance XDctMulti (GhcPass _) = NoExtField +type instance XXDerivClauseTys (GhcPass _) = NoExtCon + +instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where + ppr (DctSingle _ ty) = ppr ty + ppr (DctMulti _ tys) = parens (interpp'SP tys) + -- | Located Standalone Kind Signature type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -446,6 +446,12 @@ type family XXHsDataDefn x type family XCHsDerivingClause x type family XXHsDerivingClause x +-- ------------------------------------- +-- DerivClauseTys type families +type family XDctSingle x +type family XDctMulti x +type family XXDerivClauseTys x + -- ------------------------------------- -- ConDecl type families type family XConDeclGADT x ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -163,6 +163,11 @@ deriving instance Data (HsDerivingClause GhcPs) deriving instance Data (HsDerivingClause GhcRn) deriving instance Data (HsDerivingClause GhcTc) +-- deriving instance DataIdLR p p => Data (DerivClauseTys p) +deriving instance Data (DerivClauseTys GhcPs) +deriving instance Data (DerivClauseTys GhcRn) +deriving instance Data (DerivClauseTys GhcTc) + -- deriving instance (DataIdLR p p) => Data (ConDecl p) deriving instance Data (ConDecl GhcPs) deriving instance Data (ConDecl GhcRn) ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -193,13 +193,19 @@ subordinates instMap decl = case decl of , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], M.empty) - | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $ - concatMap (unLoc . deriv_clause_tys . unLoc) $ + | (l, doc) <- concatMap (extract_deriv_clause_tys . + deriv_clause_tys . unLoc) $ unLoc $ dd_derivs dd , Just instName <- [lookupSrcSpan l instMap] ] - extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString) - extract_deriv_ty (L l ty) = + extract_deriv_clause_tys :: LDerivClauseTys GhcRn -> [(SrcSpan, LHsDocString)] + extract_deriv_clause_tys (L _ dct) = + case dct of + DctSingle _ ty -> maybeToList $ extract_deriv_ty ty + DctMulti _ tys -> mapMaybe extract_deriv_ty tys + + extract_deriv_ty :: LHsSigType GhcRn -> Maybe (SrcSpan, LHsDocString) + extract_deriv_ty (HsIB{hsib_body = L l ty}) = case ty of -- deriving (forall a. C a {- ^ Doc comment -}) HsForAllTy{ hst_tele = HsForAllInvis{} ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -945,13 +945,18 @@ repDerivClause :: LHsDerivingClause GhcRn -> MetaM (Core (M TH.DerivClause)) repDerivClause (L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ dct })) + , deriv_clause_tys = dct })) = repDerivStrategy dcs $ \(MkC dcs') -> - do MkC dct' <- repListM typeTyConName (rep_deriv_ty . hsSigType) dct + do MkC dct' <- rep_deriv_clause_tys dct rep2 derivClauseName [dcs',dct'] where - rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type)) - rep_deriv_ty ty = repLTy ty + rep_deriv_clause_tys :: LDerivClauseTys GhcRn -> MetaM (Core [M TH.Type]) + rep_deriv_clause_tys (L _ dct) = case dct of + DctSingle _ ty -> rep_deriv_tys [ty] + DctMulti _ tys -> rep_deriv_tys tys + + rep_deriv_tys :: [LHsSigType GhcRn] -> MetaM (Core [M TH.Type]) + rep_deriv_tys = repListM typeTyConName (repLTy . hsSigType) rep_meth_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn -> MetaM ([GenSymBind], [Core (M TH.Dec)]) ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1507,12 +1507,16 @@ instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where instance ToHie (Located (HsDerivingClause GhcRn)) where toHie (L span cl) = concatM $ makeNode cl span : case cl of - HsDerivingClause _ strat (L ispan tys) -> + HsDerivingClause _ strat dct -> [ toHie strat - , locOnly ispan - , toHie $ map (TS (ResolvedScopes [])) tys + , toHie dct ] +instance ToHie (Located (DerivClauseTys GhcRn)) where + toHie (L span dct) = concatM $ makeNode dct span : case dct of + DctSingle _ ty -> [ toHie $ TS (ResolvedScopes[]) ty ] + DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ] + instance ToHie (Located (DerivStrategy GhcRn)) where toHie (L span strat) = concatM $ makeNode strat span : case strat of StockStrategy -> [] ===================================== compiler/GHC/Parser.y ===================================== @@ -2276,15 +2276,13 @@ deriving :: { LHsDerivingClause GhcPs } in ams (L full_loc $ HsDerivingClause noExtField (Just $3) $2) [mj AnnDeriving $1] } -deriv_clause_types :: { Located [LHsSigType GhcPs] } +deriv_clause_types :: { LDerivClauseTys GhcPs } : qtycon { let { tc = sL1 $1 (HsTyVar noExtField NotPromoted $1) } in - sL1 $1 [mkLHsSigType tc] } - | '(' ')' {% ams (sLL $1 $> []) + sL1 $1 (DctSingle noExtField (mkLHsSigType tc)) } + | '(' ')' {% ams (sLL $1 $> (DctMulti noExtField [])) [mop $1,mcp $2] } - | '(' deriv_types ')' {% ams (sLL $1 $> $2) + | '(' deriv_types ')' {% ams (sLL $1 $> (DctMulti noExtField $2)) [mop $1,mcp $3] } - -- Glasgow extension: allow partial - -- applications in derivings ----------------------------------------------------------------------------- -- Value definitions ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -628,15 +628,34 @@ instance HasHaddock (Located (HsDerivingClause GhcPs)) where Just (L l (ViaStrategy _)) -> (pure (), registerLocHdkA l) Just (L l _) -> (registerLocHdkA l, pure ()) register_strategy_before - deriv_clause_tys' <- - extendHdkA (getLoc deriv_clause_tys) $ - traverse @Located addHaddock deriv_clause_tys + deriv_clause_tys' <- addHaddock deriv_clause_tys register_strategy_after pure HsDerivingClause { deriv_clause_ext = noExtField, deriv_clause_strategy, deriv_clause_tys = deriv_clause_tys' } +-- Process the types in a single deriving clause, which may come in one of the +-- following forms: +-- +-- 1. A singular type constructor: +-- deriving Eq -- ^ Comment on Eq +-- +-- 2. A list of comma-separated types surrounded by enclosing parentheses: +-- deriving ( Eq -- ^ Comment on Eq +-- , C a -- ^ Comment on C a +-- ) +instance HasHaddock (Located (DerivClauseTys GhcPs)) where + addHaddock (L l_dct dct) = + extendHdkA l_dct $ + case dct of + DctSingle x ty -> do + ty' <- addHaddock ty + pure $ L l_dct $ DctSingle x ty' + DctMulti x tys -> do + tys' <- addHaddock tys + pure $ L l_dct $ DctMulti x tys' + -- Process a single data constructor declaration, which may come in one of the -- following forms: -- ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1895,15 +1895,25 @@ rnLHsDerivingClause doc (L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs - , deriv_clause_tys = L loc' dct })) + , deriv_clause_tys = dct })) = do { (dcs', dct', fvs) - <- rnLDerivStrategy doc dcs $ mapFvRn rn_clause_pred dct + <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct ; warnNoDerivStrat dcs' loc ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField , deriv_clause_strategy = dcs' - , deriv_clause_tys = L loc' dct' }) + , deriv_clause_tys = dct' }) , fvs ) } where + rn_deriv_clause_tys :: LDerivClauseTys GhcPs + -> RnM (LDerivClauseTys GhcRn, FreeVars) + rn_deriv_clause_tys (L l dct) = case dct of + DctSingle x ty -> do + (ty', fvs) <- rn_clause_pred ty + pure (L l (DctSingle x ty'), fvs) + DctMulti x tys -> do + (tys', fvs) <- mapFvRn rn_clause_pred tys + pure (L l (DctMulti x tys'), fvs) + rn_clause_pred :: LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars) rn_clause_pred pred_ty = do let inf_err = Just (text "Inferred type variables are not allowed") ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -437,17 +437,22 @@ makeDerivSpecs :: [DerivInfo] -> TcM [EarlyDerivSpec] makeDerivSpecs deriv_infos deriv_decls = do { eqns1 <- sequenceA - [ deriveClause rep_tc scoped_tvs dcs preds err_ctxt + [ deriveClause rep_tc scoped_tvs dcs (deriv_clause_preds dct) err_ctxt | DerivInfo { di_rep_tc = rep_tc , di_scoped_tvs = scoped_tvs , di_clauses = clauses , di_ctxt = err_ctxt } <- deriv_infos , L _ (HsDerivingClause { deriv_clause_strategy = dcs - , deriv_clause_tys = L _ preds }) + , deriv_clause_tys = dct }) <- clauses ] ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls ; return $ concat eqns1 ++ catMaybes eqns2 } + where + deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn] + deriv_clause_preds (L _ dct) = case dct of + DctSingle _ ty -> [ty] + DctMulti _ tys -> tys ------------------------------------------------------------------ -- | Process the derived classes in a single @deriving@ clause. ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1393,12 +1393,25 @@ cvtContext p tys = do { preds' <- mapM cvtPred tys cvtPred :: TH.Pred -> CvtM (LHsType GhcPs) cvtPred = cvtType +cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs) +cvtDerivClauseTys tys + = do { tys' <- mapM cvtType tys + -- Since TH.Cxt doesn't indicate the presence or absence of + -- parentheses in a deriving clause, we have to choose between + -- DctSingle and DctMulti somewhat arbitrarily. We opt to use DctMulti + -- unless the TH.Cxt is a singleton list whose type is a bare type + -- constructor with no arguments. + ; case tys' of + [ty'@(L l (HsTyVar _ NotPromoted _))] + -> return $ L l $ DctSingle noExtField $ mkLHsSigType ty' + _ -> returnL $ DctMulti noExtField (map mkLHsSigType tys') } + cvtDerivClause :: TH.DerivClause -> CvtM (LHsDerivingClause GhcPs) -cvtDerivClause (TH.DerivClause ds ctxt) - = do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt - ; ds' <- traverse cvtDerivStrategy ds - ; returnL $ HsDerivingClause noExtField ds' ctxt' } +cvtDerivClause (TH.DerivClause ds tys) + = do { tys' <- cvtDerivClauseTys tys + ; ds' <- traverse cvtDerivStrategy ds + ; returnL $ HsDerivingClause noExtField ds' tys' } cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs) cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4283feaa9e0826211f7a71d543054c989ea32965 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4283feaa9e0826211f7a71d543054c989ea32965 You're receiving 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 15 19:52:55 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 15:52:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Fix rtsopts documentation Message-ID: <5f611b972cfad_80b3f849be98a7c1229857a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 182b7bd1 by Ryan Scott at 2020-09-15T15:52:41-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - d04b981e by Sylvain Henry at 2020-09-15T15:52:46-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 168a4a39 by Sylvain Henry at 2020-09-15T15:52:48-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 30 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - compiler/ghc.cabal.in - compiler/ghc.mk - docs/users_guide/flags.py - docs/users_guide/flags.rst - docs/users_guide/phases.rst - ghc.mk - ghc/ghc-bin.cabal.in - ghc/ghc.mk - hadrian/src/Settings/Packages.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b49af09cbcf73c18253adf3e381e46c915d5b13...168a4a397e0a9ad4d07d783f0ae5d91b2d9cabc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b49af09cbcf73c18253adf3e381e46c915d5b13...168a4a397e0a9ad4d07d783f0ae5d91b2d9cabc6 You're receiving 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 15 21:26:51 2020 From: gitlab at gitlab.haskell.org (Leif Metcalf) Date: Tue, 15 Sep 2020 17:26:51 -0400 Subject: [Git][ghc/ghc][wip/trivial-readme] 11 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f61319b84af8_80b3f8473fb593c1230547f@gitlab.haskell.org.mail> Leif Metcalf pushed to branch wip/trivial-readme at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - cbab9d87 by Leif Metcalf at 2020-09-15T17:26:49-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - 30 changed files: - .gitlab-ci.yml - README.md - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - docs/users_guide/phases.rst - docs/users_guide/runtime_control.rst - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr - testsuite/tests/simplCore/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ecbce4d7c97cb513c181ff674fa9743b517620...cbab9d87af15f7904f9159b1f0f65b883b7061c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ecbce4d7c97cb513c181ff674fa9743b517620...cbab9d87af15f7904f9159b1f0f65b883b7061c1 You're receiving 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 15 21:27:39 2020 From: gitlab at gitlab.haskell.org (Leif Metcalf) Date: Tue, 15 Sep 2020 17:27:39 -0400 Subject: [Git][ghc/ghc][wip/z-encoding-note] 12 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f6131cbba9ee_80b3f84624376ac12305952@gitlab.haskell.org.mail> Leif Metcalf pushed to branch wip/z-encoding-note at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 376ba2fc by Leif Metcalf at 2020-09-15T17:27:38-04:00 Make Z-encoding comment into a note - - - - - d722c58e by Leif Metcalf at 2020-09-15T17:27:38-04:00 Cosmetic - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.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/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.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 - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/Encoding.hs - docs/users_guide/phases.rst - docs/users_guide/runtime_control.rst - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92920fa74756133a1b2f9aba9ef1ca648bad1b9c...d722c58e3e2311e655d778bb027bf4010dd23e66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92920fa74756133a1b2f9aba9ef1ca648bad1b9c...d722c58e3e2311e655d778bb027bf4010dd23e66 You're receiving 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 15 22:06:01 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 15 Sep 2020 18:06:01 -0400 Subject: [Git][ghc/ghc][wip/doc-iface-tuple-ty] Document IfaceTupleTy Message-ID: <5f613ac9377d5_80b3f847d58a46c12311429@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/doc-iface-tuple-ty at Glasgow Haskell Compiler / GHC Commits: 9cc82650 by Richard Eisenberg at 2020-09-15T18:05:50-04:00 Document IfaceTupleTy - - - - - 1 changed file: - compiler/GHC/Iface/Type.hs Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -176,6 +176,11 @@ data IfaceType PromotionFlag -- A bit like IfaceTyCon IfaceAppArgs -- arity = length args -- For promoted data cons, the kind args are omitted + -- Why have this? Only for efficiency: IfaceTupleTy can omit the + -- type arguments, as they can be recreated when deserializing. + -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression + -- in interface file size (in GHC's boot libraries). + -- See !3987. type IfaceMult = IfaceType View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cc826502c0fb811006185d92db7671d0d2c8a12 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cc826502c0fb811006185d92db7671d0d2c8a12 You're receiving 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 15 22:36:23 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 15 Sep 2020 18:36:23 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] 43 commits: configure: Work around Raspbian's silly packaging decisions Message-ID: <5f6141e791856_80bb1e1238123241fa@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint 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 - - - - - 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. - - - - - 1da8b6b2 by Alan Zimmerman at 2020-09-15T23:35:54+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 Remove LHsLocalBinds 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: - .gitlab-ci.yml - .gitlab/ci.sh - .gitmodules - aclocal.m4 - compiler/GHC.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/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2b9f73904246d32f8dfefde3b53a700a2950f1f...1da8b6b2ab726583632292cc80f598ddcaf05e8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2b9f73904246d32f8dfefde3b53a700a2950f1f...1da8b6b2ab726583632292cc80f598ddcaf05e8c You're receiving 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 15 22:40:45 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Tue, 15 Sep 2020 18:40:45 -0400 Subject: [Git][ghc/ghc][wip/T18653] 5 commits: Avoid iterating twice in `zipTyEnv` (#18535) Message-ID: <5f6142ed77238_80bab66a34123248e8@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18653 at Glasgow Haskell Compiler / GHC Commits: 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 1c8f1db5 by Krzysztof Gogolewski at 2020-09-16T00:40:33+02:00 Fix printing of promoted unboxed tuples (#18653) - - - - - 24 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Unique/FM.hs - compiler/ghc.cabal.in - + testsuite/tests/ghci/scripts/T18653.script - + testsuite/tests/ghci/scripts/T18653.stdout - testsuite/tests/ghci/scripts/all.T - + 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/Builtin/Types.hs ===================================== @@ -1018,7 +1018,9 @@ mk_tuple Unboxed arity = (tycon, tuple_con) UnboxedTuple flavour -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon - -- Kind: forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> # + -- Example: the kind of (#,#) is + -- forall (k1::RuntimeRep) (k2::RuntimeRep). TYPE k1 -> TYPE k2 -> + -- TYPE (TupleRep '[k1, k2]) tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy) (\ks -> map tYPE ks) ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -440,7 +440,7 @@ zipTyEnv tyvars tys = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys) | otherwise = ASSERT( all (not . isCoercionTy) tys ) - mkVarEnv (zipEqual "zipTyEnv" tyvars tys) + zipToUFM tyvars tys -- There used to be a special case for when -- ty == TyVarTy tv -- (a not-uncommon case) in which case the substitution was dropped. ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -189,7 +189,7 @@ toIfaceTypeX fr (TyConApp tc tys) | Just dc <- isPromotedDataCon_maybe tc , isBoxedTupleDataCon dc - , n_tys == 2*arity + , n_tys == arity = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ] ===================================== 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,7 +37,6 @@ 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.Data.Bag import GHC.Types.Name.Reader @@ -58,6 +58,7 @@ import GHC.Hs.Extension import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe +import qualified Data.Kind {- ************************************************************************ @@ -89,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/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/PmCheck/Oracle.hs ===================================== @@ -584,13 +584,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) @@ -597,15 +596,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/HsToCore/Types.hs ===================================== @@ -0,0 +1,85 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + +-- | 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 (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) + +{- +************************************************************************ +* * + 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 + +-- See Note [The Decoupling Abstract Data Hack] +type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1573,7 +1573,18 @@ pprTuple ctxt_prec sort promoted args = case promoted of IsPromoted -> let tys = appArgsIfaceTypes args - args' = drop (length tys `div` 2) tys + -- For promoted boxed tuples, drop half of the type arguments: + -- display '(,) @Type @(Type -> Type) Int Maybe + -- as '(Int, Maybe) + -- For promoted unboxed tuples, additionally drop RuntimeRep vars; + -- display '(#,#) @LiftedRep @LiftedRep @Type @(Type -> Type) Int Maybe + -- as '(# Int, Maybe #) + -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon + -- and ticket #18653 + toDrop = case sort of + UnboxedTuple -> 2 * length tys `div` 3 + _ -> length tys `div` 2 + args' = drop toDrop tys spaceIfPromoted = case args' of arg0:_ -> pprSpaceIfPromotedTyCon arg0 _ -> id ===================================== 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/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 ===================================== 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/Types/Unique/FM.hs ===================================== @@ -23,6 +23,7 @@ of arguments of combining function. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module GHC.Types.Unique.FM ( @@ -34,6 +35,7 @@ module GHC.Types.Unique.FM ( emptyUFM, unitUFM, unitDirectlyUFM, + zipToUFM, listToUFM, listToUFM_Directly, listToUFM_C, @@ -75,11 +77,14 @@ module GHC.Types.Unique.FM ( pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM ) where +#include "HsVersions.h" + import GHC.Prelude import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) import GHC.Utils.Outputable - +import GHC.Utils.Panic (assertPanic) +import GHC.Utils.Misc (debugIsOn) import qualified Data.IntMap as M import qualified Data.IntSet as S import Data.Data @@ -113,6 +118,19 @@ unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v) unitDirectlyUFM :: Unique -> elt -> UniqFM key elt unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) +-- zipToUFM ks vs = listToUFM (zip ks vs) +-- This function exists because it's a common case (#18535), and +-- it's inefficient to first build a list of pairs, and then immediately +-- take it apart. Astonishingly, fusing this one list away reduces total +-- compiler allocation by more than 10% (in T12545, see !3935) +-- Note that listToUFM (zip ks vs) performs similarly, but +-- the explicit recursion avoids relying too much on fusion. +zipToUFM :: Uniquable key => [key] -> [elt] -> UniqFM key elt +zipToUFM ks vs = ASSERT( length ks == length vs ) innerZip emptyUFM ks vs + where + innerZip ufm (k:kList) (v:vList) = innerZip (addToUFM ufm k v) kList vList + innerZip ufm _ _ = ufm + listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM ===================================== compiler/ghc.cabal.in ===================================== @@ -314,6 +314,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call ===================================== testsuite/tests/ghci/scripts/T18653.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(#,,,#) Int Char Bool Maybe +:kind! '(,,,) Int Char Bool Maybe ===================================== testsuite/tests/ghci/scripts/T18653.stdout ===================================== @@ -0,0 +1,4 @@ +'(#,,,#) Int Char Bool Maybe :: (# *, *, *, * -> * #) += '(# Int, Char, Bool, Maybe #) +'(,,,) Int Char Bool Maybe :: (*, *, *, * -> *) += '(Int, Char, Bool, Maybe) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -319,3 +319,4 @@ 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']) +test('T18653', normal, ghci_script, ['T18653.script']) ===================================== 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/-/compare/66ffd87ace6cd8e11bfaeae62991561a11731bcd...1c8f1db585dc5f4fb6a215152cf47963ce8f52bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/66ffd87ace6cd8e11bfaeae62991561a11731bcd...1c8f1db585dc5f4fb6a215152cf47963ce8f52bd You're receiving 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 16 02:43:23 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 15 Sep 2020 22:43:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Include -f{write,validate}-ide-info in the User's Guide flag reference Message-ID: <5f617bcb3b70c_80b3f84507179ec123363e1@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6bb8dc2e by Ryan Scott at 2020-09-15T22:43:10-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - bed502df by Ben Gamari at 2020-09-15T22:43:10-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - 409d9150 by Sylvain Henry at 2020-09-15T22:43:12-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 98ff87a3 by Sylvain Henry at 2020-09-15T22:43:14-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 11 changed files: - compiler/ghc.cabal.in - compiler/ghc.mk - docs/users_guide/flags.py - docs/users_guide/flags.rst - ghc.mk - ghc/ghc-bin.cabal.in - ghc/ghc.mk - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - rts/RtsMessages.c Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -23,8 +23,8 @@ Category: Development Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -72,7 +72,6 @@ Library transformers == 0.5.*, exceptions == 0.10.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ @@ -88,7 +87,7 @@ Library -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER Include-Dirs: ../rts/dist/build @FFIIncludeDir@ ===================================== compiler/ghc.mk ===================================== @@ -203,7 +203,7 @@ compiler_stage1_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS endif ifeq "$(GhcWithInterpreter)" "YES" -compiler_stage2_CONFIGURE_OPTS += --flags=ghci +compiler_stage2_CONFIGURE_OPTS += --flags=internal-interpreter # Should the debugger commands be enabled? ifeq "$(GhciWithDebugger)" "YES" ===================================== docs/users_guide/flags.py ===================================== @@ -64,6 +64,7 @@ categories = { 'coverage': 'Program coverage', 'cpp': 'C pre-processor', 'debugging': 'Debugging the compiler', + 'extended-interface-files': 'Extended interface files', 'interactive': 'Interactive mode', 'interface-files': 'Interface files', 'keep-intermediates': 'Keeping intermediate files', ===================================== docs/users_guide/flags.rst ===================================== @@ -127,6 +127,21 @@ More details in :ref:`hi-options` :type: table :category: interface-files +Extended interface file options +------------------------------- + +More details in :ref:`hie-options` + +.. tabularcolumns:: + | p{\dimexpr 0.30\textwidth-2\tabcolsep} | + p{\dimexpr 0.31\textwidth-2\tabcolsep} | + p{\dimexpr 0.11\textwidth-2\tabcolsep} | + p{\dimexpr 0.29\textwidth-2\tabcolsep} | + +.. flag-print:: + :type: table + :category: extended-interface-files + Recompilation checking ---------------------- ===================================== ghc.mk ===================================== @@ -598,7 +598,7 @@ endif BOOT_LIBS = $(foreach lib,$(PACKAGES_STAGE0),$(libraries/$(lib)_dist-boot_v_LIB)) # Only build internal interpreter support for the stage2 ghci lib -libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=ghci +libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=internal-interpreter # ---------------------------------------- # Special magic for the ghc-prim package ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -19,8 +19,8 @@ Data-Files: settings Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -55,7 +55,7 @@ Executable ghc -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq == 1.4.*, @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== ghc/ghc.mk ===================================== @@ -19,8 +19,8 @@ ghc_stage2_CONFIGURE_OPTS += --flags=stage2 ghc_stage3_CONFIGURE_OPTS += --flags=stage3 ifeq "$(GhcWithInterpreter)" "YES" -ghc_stage2_CONFIGURE_OPTS += --flags=ghci -ghc_stage3_CONFIGURE_OPTS += --flags=ghci +ghc_stage2_CONFIGURE_OPTS += --flags=internal-interpreter +ghc_stage3_CONFIGURE_OPTS += --flags=internal-interpreter endif # This package doesn't pass the Cabal checks because data-dir ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -73,7 +73,7 @@ packageArgs = do notStage0 ? arg "--ghc-pkg-option=--force" ] , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" ] @@ -84,7 +84,7 @@ packageArgs = do [ builder Ghc ? arg ("-I" ++ compilerPath) , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" -- Note [Linking ghc-bin against threaded stage0 RTS] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -121,13 +121,13 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ notStage0 ? builder (Cabal Flags) ? arg "ghci" + [ notStage0 ? builder (Cabal Flags) ? arg "internal-interpreter" - -- The use case here is that we want to build @ghc-proxy@ for the + -- The use case here is that we want to build @iserv-proxy@ for the -- cross compiler. That one needs to be compiled by the bootstrap -- compiler as it needs to run on the host. Hence @libiserv@ needs -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci at . And those are - -- behind the @-fghci@ flag. + -- behind the @-finternal-interpreter@ flag. -- -- But it may not build if we have made some changes to ghci's -- dependencies (see #16051). @@ -142,13 +142,14 @@ packageArgs = do -- -- The workaround we use is to check if the bootstrap compiler has -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with `-fghci`. + -- avoid the first step above and directly build with + -- `-finternal-interpreter`. -- -- TODO: Note that in that case we also do not need to build most of -- the Stage1 libraries, as we already know that the bootstrap -- compiler comes with the same versions as the one we are building. -- - , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "ghci" + , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "internal-interpreter" ] ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -49,6 +49,14 @@ Library GHC.UniqueSubdir GHC.Version + -- reexport modules from ghc-boot-th so that packages don't have to import + -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to + -- understand and to refactor. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + -- but done by Hadrian -- autogen-modules: -- GHC.Version ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,8 +17,8 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -47,7 +47,7 @@ library TupleSections UnboxedTuples - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run @@ -79,7 +79,6 @@ library deepseq == 1.4.*, filepath == 1.4.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, template-haskell == 2.17.*, transformers == 0.5.* ===================================== rts/RtsMessages.c ===================================== @@ -248,7 +248,7 @@ rtsSysErrorMsgFn(const char *s, va_list ap) r = vsnprintf(buf, BUFSIZE, s, ap); if (r > 0 && r < BUFSIZE) { - r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr); + r = snprintf(buf+r, BUFSIZE-r, ": %s", syserr); MessageBox(NULL /* hWnd */, buf, prog_name, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/168a4a397e0a9ad4d07d783f0ae5d91b2d9cabc6...98ff87a38d6a896a002ac9014327b1cfddeb28ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/168a4a397e0a9ad4d07d783f0ae5d91b2d9cabc6...98ff87a38d6a896a002ac9014327b1cfddeb28ce You're receiving 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 16 08:53:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 04:53:30 -0400 Subject: [Git][ghc/ghc][master] Include -f{write,validate}-ide-info in the User's Guide flag reference Message-ID: <5f61d28ad4ae6_80b3f846946a4381235366b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - 2 changed files: - docs/users_guide/flags.py - docs/users_guide/flags.rst Changes: ===================================== docs/users_guide/flags.py ===================================== @@ -64,6 +64,7 @@ categories = { 'coverage': 'Program coverage', 'cpp': 'C pre-processor', 'debugging': 'Debugging the compiler', + 'extended-interface-files': 'Extended interface files', 'interactive': 'Interactive mode', 'interface-files': 'Interface files', 'keep-intermediates': 'Keeping intermediate files', ===================================== docs/users_guide/flags.rst ===================================== @@ -127,6 +127,21 @@ More details in :ref:`hi-options` :type: table :category: interface-files +Extended interface file options +------------------------------- + +More details in :ref:`hie-options` + +.. tabularcolumns:: + | p{\dimexpr 0.30\textwidth-2\tabcolsep} | + p{\dimexpr 0.31\textwidth-2\tabcolsep} | + p{\dimexpr 0.11\textwidth-2\tabcolsep} | + p{\dimexpr 0.29\textwidth-2\tabcolsep} | + +.. flag-print:: + :type: table + :category: extended-interface-files + Recompilation checking ---------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90229c4b781184d0e59ac67afda90ed316f62bcd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90229c4b781184d0e59ac67afda90ed316f62bcd You're receiving 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 16 08:54:06 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 04:54:06 -0400 Subject: [Git][ghc/ghc][master] rts: Fix erroneous usage of vsnprintf Message-ID: <5f61d2ae3230d_80b3f848b47aeec123574fd@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - 1 changed file: - rts/RtsMessages.c Changes: ===================================== rts/RtsMessages.c ===================================== @@ -248,7 +248,7 @@ rtsSysErrorMsgFn(const char *s, va_list ap) r = vsnprintf(buf, BUFSIZE, s, ap); if (r > 0 && r < BUFSIZE) { - r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr); + r = snprintf(buf+r, BUFSIZE-r, ": %s", syserr); MessageBox(NULL /* hWnd */, buf, prog_name, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce42e187ebfc81174ed477f247f023ae094c9b24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce42e187ebfc81174ed477f247f023ae094c9b24 You're receiving 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 16 08:54:44 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 04:54:44 -0400 Subject: [Git][ghc/ghc][master] Rename ghci flag into internal-interpreter Message-ID: <5f61d2d414964_80b3f848a05d50412358435@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 7 changed files: - compiler/ghc.cabal.in - compiler/ghc.mk - ghc.mk - ghc/ghc-bin.cabal.in - ghc/ghc.mk - hadrian/src/Settings/Packages.hs - libraries/ghci/ghci.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -23,8 +23,8 @@ Category: Development Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -88,7 +88,7 @@ Library -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER Include-Dirs: ../rts/dist/build @FFIIncludeDir@ ===================================== compiler/ghc.mk ===================================== @@ -203,7 +203,7 @@ compiler_stage1_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS endif ifeq "$(GhcWithInterpreter)" "YES" -compiler_stage2_CONFIGURE_OPTS += --flags=ghci +compiler_stage2_CONFIGURE_OPTS += --flags=internal-interpreter # Should the debugger commands be enabled? ifeq "$(GhciWithDebugger)" "YES" ===================================== ghc.mk ===================================== @@ -598,7 +598,7 @@ endif BOOT_LIBS = $(foreach lib,$(PACKAGES_STAGE0),$(libraries/$(lib)_dist-boot_v_LIB)) # Only build internal interpreter support for the stage2 ghci lib -libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=ghci +libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=internal-interpreter # ---------------------------------------- # Special magic for the ghc-prim package ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -19,8 +19,8 @@ Data-Files: settings Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -55,7 +55,7 @@ Executable ghc -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq == 1.4.*, @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== ghc/ghc.mk ===================================== @@ -19,8 +19,8 @@ ghc_stage2_CONFIGURE_OPTS += --flags=stage2 ghc_stage3_CONFIGURE_OPTS += --flags=stage3 ifeq "$(GhcWithInterpreter)" "YES" -ghc_stage2_CONFIGURE_OPTS += --flags=ghci -ghc_stage3_CONFIGURE_OPTS += --flags=ghci +ghc_stage2_CONFIGURE_OPTS += --flags=internal-interpreter +ghc_stage3_CONFIGURE_OPTS += --flags=internal-interpreter endif # This package doesn't pass the Cabal checks because data-dir ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -73,7 +73,7 @@ packageArgs = do notStage0 ? arg "--ghc-pkg-option=--force" ] , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" ] @@ -84,7 +84,7 @@ packageArgs = do [ builder Ghc ? arg ("-I" ++ compilerPath) , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" -- Note [Linking ghc-bin against threaded stage0 RTS] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -121,13 +121,13 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ notStage0 ? builder (Cabal Flags) ? arg "ghci" + [ notStage0 ? builder (Cabal Flags) ? arg "internal-interpreter" - -- The use case here is that we want to build @ghc-proxy@ for the + -- The use case here is that we want to build @iserv-proxy@ for the -- cross compiler. That one needs to be compiled by the bootstrap -- compiler as it needs to run on the host. Hence @libiserv@ needs -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci at . And those are - -- behind the @-fghci@ flag. + -- behind the @-finternal-interpreter@ flag. -- -- But it may not build if we have made some changes to ghci's -- dependencies (see #16051). @@ -142,13 +142,14 @@ packageArgs = do -- -- The workaround we use is to check if the bootstrap compiler has -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with `-fghci`. + -- avoid the first step above and directly build with + -- `-finternal-interpreter`. -- -- TODO: Note that in that case we also do not need to build most of -- the Stage1 libraries, as we already know that the bootstrap -- compiler comes with the same versions as the one we are building. -- - , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "ghci" + , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "internal-interpreter" ] ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,8 +17,8 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -47,7 +47,7 @@ library TupleSections UnboxedTuples - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b695e7d73617ab19170d37b383315e8ede289c5e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b695e7d73617ab19170d37b383315e8ede289c5e You're receiving 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 16 08:55:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 04:55:24 -0400 Subject: [Git][ghc/ghc][master] Make ghc-boot reexport modules from ghc-boot-th Message-ID: <5f61d2fc7bcf1_80b3f848b6b7cc81236228b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 3 changed files: - compiler/ghc.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -72,7 +72,6 @@ Library transformers == 0.5.*, exceptions == 0.10.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -49,6 +49,14 @@ Library GHC.UniqueSubdir GHC.Version + -- reexport modules from ghc-boot-th so that packages don't have to import + -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to + -- understand and to refactor. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + -- but done by Hadrian -- autogen-modules: -- GHC.Version ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -79,7 +79,6 @@ library deepseq == 1.4.*, filepath == 1.4.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, template-haskell == 2.17.*, transformers == 0.5.* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8af954d202de1de0671062c3f55e43fc783f8192 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8af954d202de1de0671062c3f55e43fc783f8192 You're receiving 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 16 09:26:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 05:26:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Include -f{write,validate}-ide-info in the User's Guide flag reference Message-ID: <5f61da3775910_80b3f8496052314123762d1@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 5f425b09 by Simon Peyton Jones at 2020-09-16T05:26:06-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - e0b61fb1 by Leif Metcalf at 2020-09-16T05:26:06-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - c6dda93b by Richard Eisenberg at 2020-09-16T05:26:06-04:00 Document IfaceTupleTy - - - - - 19 changed files: - README.md - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Demand.hs - compiler/ghc.cabal.in - compiler/ghc.mk - docs/users_guide/flags.py - docs/users_guide/flags.rst - ghc.mk - ghc/ghc-bin.cabal.in - ghc/ghc.mk - hadrian/src/Settings/Packages.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - rts/RtsMessages.c - + testsuite/tests/simplCore/should_run/T18638.hs - + testsuite/tests/simplCore/should_run/T18638.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== README.md ===================================== @@ -26,7 +26,7 @@ There are two ways to get a source tree: 2. *Check out the source code from git* - $ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git + $ git clone --recurse-submodules git at gitlab.haskell.org:ghc/ghc.git Note: cloning GHC from Github requires a special setup. See [Getting a GHC repository from Github][7]. ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -34,9 +34,10 @@ module GHC.Core.FVs ( bndrRuleAndUnfoldingVarsDSet, idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, - ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, + ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, + ruleRhsFreeVars, ruleRhsFreeIds, expr_fvs, @@ -524,6 +525,14 @@ ruleLhsFVIds (BuiltinRule {}) = emptyFV ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) +ruleRhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) + = fvVarSet $ filterFV isLocalId $ + addBndrs bndrs $ exprs_fvs args + {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.Seq ( seqBinds ) import GHC.Utils.Outputable import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Basic import Data.List ( mapAccumL ) import GHC.Core.DataCon @@ -32,6 +33,7 @@ import GHC.Types.Id.Info import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type +import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import GHC.Utils.Misc @@ -552,7 +554,9 @@ 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 + DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty + sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) -- See Note [Aggregated demand for cardinality] @@ -560,10 +564,23 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs Just bs -> reuseEnv (delVarEnvList rhs_fv bs) Nothing -> rhs_fv + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs + -- See Note [Lazy and unleashable free variables] - (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv1 + (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv2 is_thunk = not (exprIsHNF rhs) && not (isJoinId id) + -- Find the RHS free vars of the unfoldings and RULES + -- See Note [Absence analysis for stable unfoldings and RULES] + extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ + idCoreRules id + + unf = realIdUnfolding id + unf_fvs | isStableUnfolding unf + , Just unf_body <- maybeUnfoldingTemplate unf + = exprFreeIds unf_body + | otherwise = emptyVarSet + -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for -- unleashing on the given function's @rhs@, by creating -- a call demand of @rhs_arity@ @@ -799,6 +816,43 @@ 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 and RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +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, adjust its DmdEnv (the demands +on its free variables) so that no variable mentioned in its unfolding +is Absent. This is done by the function Demand.keepAliveDmdEnv. + +ALSO: do the same for Ids free in the RHS of any RULES for f. + +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 + {-# INLINE 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/Iface/Type.hs ===================================== @@ -176,6 +176,11 @@ data IfaceType PromotionFlag -- A bit like IfaceTyCon IfaceAppArgs -- arity = length args -- For promoted data cons, the kind args are omitted + -- Why have this? Only for efficiency: IfaceTupleTy can omit the + -- type arguments, as they can be recreated when deserializing. + -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression + -- in interface file size (in GHC's boot libraries). + -- See !3987. type IfaceMult = IfaceType ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Types.Demand ( BothDmdArg, mkBothDmdArg, toBothDmdArg, nopDmdType, botDmdType, addDemand, - DmdEnv, emptyDmdEnv, + DmdEnv, emptyDmdEnv, keepAliveDmdEnv, peelFV, findIdDemand, Divergence(..), lubDivergence, isDeadEndDiv, @@ -59,8 +59,9 @@ module GHC.Types.Demand ( import GHC.Prelude -import GHC.Types.Var ( Var ) +import GHC.Types.Var ( Var, Id ) import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Data.Maybe ( orElse ) @@ -809,10 +810,22 @@ splitFVs is_thunk rhs_fvs :*: addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs }) -data StrictPair a b = !a :*: !b +keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv +-- (keepAliveDmdType dt vs) makes sure that the Ids in vs have +-- /some/ usage in the returned demand types -- they are not Absent +-- See Note [Absence analysis for stable unfoldings and RULES] +-- in GHC.Core.Opt.DmdAnal +keepAliveDmdEnv env vs + = nonDetStrictFoldVarSet add env vs + where + add :: Id -> DmdEnv -> DmdEnv + add v env = extendVarEnv_C add_dmd env v topDmd -strictPairToTuple :: StrictPair a b -> (a, b) -strictPairToTuple (x :*: y) = (x, y) + add_dmd :: Demand -> Demand -> Demand + -- If the existing usage is Absent, make it used + -- Otherwise leave it alone + add_dmd dmd _ | isAbsDmd dmd = topDmd + | otherwise = dmd splitProdDmd_maybe :: Demand -> Maybe [Demand] -- Split a product into its components, iff there is any @@ -827,6 +840,11 @@ splitProdDmd_maybe (JD { sd = s, ud = u }) (Lazy, Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux) _ -> Nothing +data StrictPair a b = !a :*: !b + +strictPairToTuple :: StrictPair a b -> (a, b) +strictPairToTuple (x :*: y) = (x, y) + {- ********************************************************************* * * TypeShape and demand trimming @@ -1541,9 +1559,9 @@ There are several wrinkles: can be evaluated in a short finite time -- and that rules out nasty cases like the one above. (I'm not quite sure why this was a problem in an earlier version of GHC, but it isn't now.) +-} - -************************************************************************ +{- ********************************************************************* * * Demand signatures * * ===================================== compiler/ghc.cabal.in ===================================== @@ -23,8 +23,8 @@ Category: Development Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -72,7 +72,6 @@ Library transformers == 0.5.*, exceptions == 0.10.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, ghci == @ProjectVersionMunged@ @@ -88,7 +87,7 @@ Library -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER Include-Dirs: ../rts/dist/build @FFIIncludeDir@ ===================================== compiler/ghc.mk ===================================== @@ -203,7 +203,7 @@ compiler_stage1_CONFIGURE_OPTS += --ghc-option=-optc-DTHREADED_RTS endif ifeq "$(GhcWithInterpreter)" "YES" -compiler_stage2_CONFIGURE_OPTS += --flags=ghci +compiler_stage2_CONFIGURE_OPTS += --flags=internal-interpreter # Should the debugger commands be enabled? ifeq "$(GhciWithDebugger)" "YES" ===================================== docs/users_guide/flags.py ===================================== @@ -64,6 +64,7 @@ categories = { 'coverage': 'Program coverage', 'cpp': 'C pre-processor', 'debugging': 'Debugging the compiler', + 'extended-interface-files': 'Extended interface files', 'interactive': 'Interactive mode', 'interface-files': 'Interface files', 'keep-intermediates': 'Keeping intermediate files', ===================================== docs/users_guide/flags.rst ===================================== @@ -127,6 +127,21 @@ More details in :ref:`hi-options` :type: table :category: interface-files +Extended interface file options +------------------------------- + +More details in :ref:`hie-options` + +.. tabularcolumns:: + | p{\dimexpr 0.30\textwidth-2\tabcolsep} | + p{\dimexpr 0.31\textwidth-2\tabcolsep} | + p{\dimexpr 0.11\textwidth-2\tabcolsep} | + p{\dimexpr 0.29\textwidth-2\tabcolsep} | + +.. flag-print:: + :type: table + :category: extended-interface-files + Recompilation checking ---------------------- ===================================== ghc.mk ===================================== @@ -598,7 +598,7 @@ endif BOOT_LIBS = $(foreach lib,$(PACKAGES_STAGE0),$(libraries/$(lib)_dist-boot_v_LIB)) # Only build internal interpreter support for the stage2 ghci lib -libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=ghci +libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=internal-interpreter # ---------------------------------------- # Special magic for the ghc-prim package ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -19,8 +19,8 @@ Data-Files: settings Build-Type: Simple Cabal-Version: >=1.10 -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -55,7 +55,7 @@ Executable ghc -Wnoncanonical-monad-instances -Wnoncanonical-monoid-instances - if flag(ghci) + if flag(internal-interpreter) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq == 1.4.*, @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== ghc/ghc.mk ===================================== @@ -19,8 +19,8 @@ ghc_stage2_CONFIGURE_OPTS += --flags=stage2 ghc_stage3_CONFIGURE_OPTS += --flags=stage3 ifeq "$(GhcWithInterpreter)" "YES" -ghc_stage2_CONFIGURE_OPTS += --flags=ghci -ghc_stage3_CONFIGURE_OPTS += --flags=ghci +ghc_stage2_CONFIGURE_OPTS += --flags=internal-interpreter +ghc_stage3_CONFIGURE_OPTS += --flags=internal-interpreter endif # This package doesn't pass the Cabal checks because data-dir ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -73,7 +73,7 @@ packageArgs = do notStage0 ? arg "--ghc-pkg-option=--force" ] , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" ] @@ -84,7 +84,7 @@ packageArgs = do [ builder Ghc ? arg ("-I" ++ compilerPath) , builder (Cabal Flags) ? mconcat - [ ghcWithInterpreter ? notStage0 ? arg "ghci" + [ ghcWithInterpreter ? notStage0 ? arg "internal-interpreter" , cross ? arg "-terminfo" -- Note [Linking ghc-bin against threaded stage0 RTS] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -121,13 +121,13 @@ packageArgs = do --------------------------------- ghci --------------------------------- , package ghci ? mconcat - [ notStage0 ? builder (Cabal Flags) ? arg "ghci" + [ notStage0 ? builder (Cabal Flags) ? arg "internal-interpreter" - -- The use case here is that we want to build @ghc-proxy@ for the + -- The use case here is that we want to build @iserv-proxy@ for the -- cross compiler. That one needs to be compiled by the bootstrap -- compiler as it needs to run on the host. Hence @libiserv@ needs -- @GHCi.TH@, @GHCi.Message@ and @GHCi.Run@ from @ghci at . And those are - -- behind the @-fghci@ flag. + -- behind the @-finternal-interpreter@ flag. -- -- But it may not build if we have made some changes to ghci's -- dependencies (see #16051). @@ -142,13 +142,14 @@ packageArgs = do -- -- The workaround we use is to check if the bootstrap compiler has -- the same version as the one we are building. In this case we can - -- avoid the first step above and directly build with `-fghci`. + -- avoid the first step above and directly build with + -- `-finternal-interpreter`. -- -- TODO: Note that in that case we also do not need to build most of -- the Stage1 libraries, as we already know that the bootstrap -- compiler comes with the same versions as the one we are building. -- - , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "ghci" + , cross ? stage0 ? bootCross ? builder (Cabal Flags) ? arg "internal-interpreter" ] ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -49,6 +49,14 @@ Library GHC.UniqueSubdir GHC.Version + -- reexport modules from ghc-boot-th so that packages don't have to import + -- both ghc-boot and ghc-boot-th. It makes the dependency graph easier to + -- understand and to refactor. + reexported-modules: + GHC.LanguageExtensions.Type + , GHC.ForeignSrcLang.Type + , GHC.Lexeme + -- but done by Hadrian -- autogen-modules: -- GHC.Version ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -17,8 +17,8 @@ cabal-version: >=1.10 build-type: Simple extra-source-files: changelog.md -Flag ghci - Description: Build GHCi support. +Flag internal-interpreter + Description: Build with internal interpreter support. Default: False Manual: True @@ -47,7 +47,7 @@ library TupleSections UnboxedTuples - if flag(ghci) + if flag(internal-interpreter) CPP-Options: -DHAVE_INTERNAL_INTERPRETER exposed-modules: GHCi.Run @@ -79,7 +79,6 @@ library deepseq == 1.4.*, filepath == 1.4.*, ghc-boot == @ProjectVersionMunged@, - ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, template-haskell == 2.17.*, transformers == 0.5.* ===================================== rts/RtsMessages.c ===================================== @@ -248,7 +248,7 @@ rtsSysErrorMsgFn(const char *s, va_list ap) r = vsnprintf(buf, BUFSIZE, s, ap); if (r > 0 && r < BUFSIZE) { - r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr); + r = snprintf(buf+r, BUFSIZE-r, ": %s", syserr); MessageBox(NULL /* hWnd */, buf, prog_name, ===================================== 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98ff87a38d6a896a002ac9014327b1cfddeb28ce...c6dda93bdf791cc19298a2c35b8bdb040394c8a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98ff87a38d6a896a002ac9014327b1cfddeb28ce...c6dda93bdf791cc19298a2c35b8bdb040394c8a7 You're receiving 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 16 11:13:15 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 07:13:15 -0400 Subject: [Git][ghc/ghc][wip/T18249] More tweaks Message-ID: <5f61f34b7651b_80b3f849642073412413930@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 7ae12890 by Sebastian Graf at 2020-09-16T13:13:01+02:00 More tweaks - - - - - 2 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -43,9 +43,10 @@ import GHC.Types.Unique.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Id -import GHC.Types.Var.Env -import GHC.Types.Var (EvVar) import GHC.Types.Name +import GHC.Types.Var (EvVar) +import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.Map @@ -85,8 +86,6 @@ import Data.Tuple (swap) import GHC.Driver.Ppr (pprTrace) -import GHC.Exts (reallyUnsafePtrEquality#, isTrue#) - -- Debugging Infrastructure tracePm :: String -> SDoc -> DsM () @@ -105,8 +104,8 @@ trc :: String -> SDoc -> a -> a trc | debugOn () = pprTrace | otherwise = \_ _ a -> a -trcM :: Monad m => String -> SDoc -> m () -trcM header doc = trc header doc (return ()) +_trcM :: Monad m => String -> SDoc -> m () +_trcM header doc = trc header doc (return ()) -- | Generate a fresh `Id` of a given type mkPmId :: Type -> DsM Id @@ -278,10 +277,11 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do , ppr (zipWith (\tv ty -> ppr tv <+> char '↦' <+> ppr ty) univ_tvs arg_tys) , ppr gammas , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr fuel ] runMaybeT $ do - nabla' <- addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) - inhabitationTest fuel (nabla_ty_st nabla) nabla' + addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) + -- inhabitationTest fuel (nabla_ty_st nabla) nabla' Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited {- Note [Strict fields and variables of unlifted type] @@ -400,7 +400,7 @@ pmTopNormaliseType :: TyState -> Type -> DsM TopNormaliseTypeResult -- NB: Normalisation can potentially change kinds, if the head of the type -- is a type family with a variable result kind. I (Richard E) can't think -- of a way to cause trouble here, though. -pmTopNormaliseType (TySt inert) typ +pmTopNormaliseType (TySt _ inert) typ = do env <- dsGetFamInstEnvs -- Before proceeding, we chuck typ into the constraint solver, in case -- solving for given equalities may reduce typ some. See @@ -582,7 +582,7 @@ nameTyCt pred_ty = do -- | Add some extra type constraints to the 'TyState'; return 'Nothing' if we -- find a contradiction (e.g. @Int ~ Bool@). tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) -tyOracle ty_st@(TySt inert) cts +tyOracle ty_st@(TySt n inert) cts | isEmptyBag cts = pure (Just ty_st) | otherwise @@ -590,7 +590,8 @@ tyOracle ty_st@(TySt inert) cts ; tracePm "tyOracle" (ppr cts $$ ppr inert) ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just mb_new_inert -> tracePm "res" (ppr mb_new_inert) >> return (TySt <$> mb_new_inert) + -- return the new inert set and increment the sequence number n + Just mb_new_inert -> return (TySt (n+1) <$> mb_new_inert) Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } {- ********************************************************************* @@ -720,12 +721,11 @@ emptyVarInfo x , vi_neg = emptyPmAltConSet , vi_bot = MaybeBot , vi_rcm = emptyRCM - , vi_dirty = False } lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env 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 @@ -781,7 +781,7 @@ where you can find the solution in a perhaps more digestible format. lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt (SDIE env) _) } k = +lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt{ts_facts = (SDIE env)}) } k = case lookupUDFM_Directly env (getUnique k) of Nothing -> [] Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) @@ -924,14 +924,14 @@ addPhiCt nabla (PhiNotBotCt x) = addNotBotCt nabla x -- 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 +addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } 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} + pure nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env y vi' } } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -940,30 +940,34 @@ addBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] -addNotConCt nabla x nalt = overVarInfo go nabla x +addNotConCt nabla x nalt = do + (mb_mark_dirty, nabla') <- trvVarInfo go nabla x + pure $ case mb_mark_dirty of + Just x -> markDirty x nabla' + Nothing -> nabla' where - go vi@(VI _ pos neg _ rcm _) = do + go vi@(VI x' pos neg _ rcm) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) -- 2. Only record the new fact when it's not already implied by one of the -- solutions let implies nalt sol = eqPmAltCon (paca_con sol) nalt == Disjoint - let neg' - | any (implies nalt) pos = neg + let (neg_changed, neg') + | any (implies nalt) pos = (False, neg) -- See Note [Completeness checking with required Thetas] - | hasRequiredTheta nalt = neg - | otherwise = extendPmAltConSet neg nalt + | hasRequiredTheta nalt = (False, neg) + | otherwise = (True, extendPmAltConSet neg nalt) MASSERT( isPmAltConMatchStrict nalt ) - let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } + let vi' = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor case nalt of - PmAltConLike cl -> do + PmAltConLike cl | neg_changed -> do -- Mark dirty to force a delayed inhabitation test rcm' <- lift (markMatched cl rcm) - pure vi1{ vi_rcm = rcm', vi_dirty = True } + pure (Just x', vi'{ vi_rcm = rcm' }) _ -> - pure vi1 + pure (Nothing, vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -1030,60 +1034,85 @@ guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- | 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 +addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } 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 -- Mark dirty for a delayed inhabitation test - let vi' = vi{ vi_bot = IsNotBot, vi_dirty = True} - pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi') reps} + let vi' = vi{ vi_bot = IsNotBot} + pure $ markDirty y + $ nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env y vi' } } + +tyStateChanged :: TyState -> TyState -> Bool +-- Makes use of the fact that the two TyStates we compare +-- will never have the same sequence number. +tyStateChanged a b = ty_st_n a /= ty_st_n b + +markDirty :: Id -> Nabla -> Nabla +markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = + nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + +traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = + go (uniqDSetToList dirty) env + where + go [] env = pure ts{ts_facts=env} + go (x:xs) !env = do + vi' <- f (lookupVarInfo ts x) + go xs (setEntrySDIE env x vi') --- | Not as unsafe as it looks! Quite a cheap test. -tyStateUnchanged :: TyState -> TyState -> Bool -tyStateUnchanged a b = isTrue# (reallyUnsafePtrEquality# a b) +traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll f ts at TmSt{ts_facts = env} = do + env' <- traverseSDIE f env + pure ts{ts_facts = env'} inhabitationTest :: Int -> TyState -> Nabla -> MaybeT DsM Nabla inhabitationTest 0 _ nabla = pure nabla -inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = TmSt env reps} = do +inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = do lift $ tracePm "inhabitation test" $ vcat [ ppr fuel , ppr old_ty_st , ppr nabla + , text "tyStateChanged:" <+> ppr (tyStateChanged old_ty_st (nabla_ty_st nabla)) ] + -- When type state didn't change, we only need to traverse dirty VarInfos + let trv_dirty | tyStateChanged old_ty_st (nabla_ty_st nabla) = traverseAll + | otherwise = traverseDirty -- We have to start the inhabitation test with a Nabla where all dirty bits -- are cleared - let clear_dirty vi = pure vi{vi_dirty = False} - cleared_env <- traverseSDIE clear_dirty env - env' <- traverseSDIE (test_one nabla{ nabla_tm_st = TmSt cleared_env reps }) env - pure nabla{ nabla_tm_st = TmSt env' reps } + ts' <- trv_dirty (test_one nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} }) ts + pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} where test_one :: Nabla -> VarInfo -> MaybeT DsM VarInfo test_one nabla vi = - lift (varNeedsTesting old_ty_st (nabla_ty_st nabla) vi) >>= \case - True | null (vi_pos vi) -> do + lift (varNeedsTesting old_ty_st nabla vi) >>= \case + True -> do -- No solution yet and needs testing - trcM "instantiate one" (ppr vi) + _trcM "instantiate one" (ppr vi) instantiate (fuel-1) nabla vi _ -> pure vi -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- --- 1. If it's marked dirty because of new negative term constraints, we have +-- 1. If it already has a solution, we don't have to test. +-- 2. If it's marked dirty because of new negative term constraints, we have -- to test. --- 2. Otherwise, if the type state didn't change, we don't need to test. --- 3. If the type state changed, we compare representation types. No need +-- 3. Otherwise, if the type state didn't change, we don't need to test. +-- 4. If the type state changed, we compare representation types. No need -- to test if unchanged. --- 4. If all the constructors of a TyCon are vanilla, we don't have to test. +-- 5. If all the constructors of a TyCon are vanilla, we don't have to test. -- "vanilla" = No strict fields and no Theta. -varNeedsTesting :: TyState -> TyState -> VarInfo -> DsM Bool -varNeedsTesting _ _ vi - | vi_dirty vi = pure True -varNeedsTesting old_ty_st new_ty_st _ +varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool +varNeedsTesting _ _ vi + | notNull (vi_pos vi) = pure False +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi + | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ -- Same type state => still inhabited - | tyStateUnchanged old_ty_st new_ty_st = pure False -varNeedsTesting old_ty_st new_ty_st vi = do + | tyStateChanged old_ty_st new_ty_st = pure False +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do (_, _, old_rep_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) (_, _, new_rep_ty) <- tntrGuts <$> pmTopNormaliseType new_ty_st (idType $ vi_id vi) if old_rep_ty `eqType` new_rep_ty @@ -1118,14 +1147,14 @@ instBot _fuel nabla vi = do pure vi trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = set_vi <$> f (lookupVarInfo ts x) where set_vi (a, vi') = - (a, nabla{ nabla_tm_st = TmSt (setEntrySDIE env (vi_id vi') vi') reps }) + (a, nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env (vi_id vi') vi' } }) -overVarInfo :: Functor f => (VarInfo -> f VarInfo) -> Nabla -> Id -> f Nabla -overVarInfo f nabla x = snd <$> trvVarInfo (\vi -> ((),) <$> f vi) nabla x +--overVarInfo :: Functor f => (VarInfo -> f VarInfo) -> Nabla -> Id -> f Nabla +--overVarInfo f nabla x = snd <$> trvVarInfo (\vi -> ((),) <$> f vi) nabla x addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x @@ -1204,7 +1233,7 @@ instCompleteSet fuel nabla x cs -- -- See Note [TmState invariants]. addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla -addVarCt nabla at MkNabla{ nabla_tm_st = TmSt env _ } x y +addVarCt nabla at MkNabla{ nabla_tm_st = TmSt{ ts_facts = 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 @@ -1220,11 +1249,11 @@ addVarCt nabla at MkNabla{ nabla_tm_st = TmSt env _ } x y -- -- See Note [TmState invariants]. equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla -equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y +equate nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x y = ASSERT( not (sameRepresentativeSDIE env x y) ) case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env x y) reps }) - (_, Nothing) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env y x) reps }) + (Nothing, _) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env x y } }) + (_, Nothing) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env y x } }) -- 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... @@ -1234,7 +1263,7 @@ equate nabla at MkNabla{ nabla_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 nabla_refs = nabla{ nabla_tm_st = TmSt env_refs reps } + let nabla_refs = nabla{ nabla_tm_st = ts{ts_facts = env_refs} } -- and then gradually merge every positive fact we have on x into y let add_fact nabla (PACA cl tvs args) = addConCt nabla y cl tvs args nabla_pos <- foldlM add_fact nabla_refs (vi_pos vi_x) @@ -1252,8 +1281,8 @@ 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@(VI _ pos neg bot _ _) = lookupVarInfo ts x +addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do + let vi@(VI _ pos neg bot _) = 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 @@ -1274,7 +1303,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})) reps} + nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1527,7 +1556,7 @@ generateInhabitants _ 0 _ = pure [] generateInhabitants [] _ nabla = pure [nabla] generateInhabitants (x:xs) n nabla = do tracePm "generateInhabitants" (ppr x $$ ppr xs $$ ppr nabla) - let VI _ pos neg _ _ _ = lookupVarInfo (nabla_tm_st nabla) x + 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 ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -521,6 +522,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -573,10 +577,6 @@ data VarInfo -- 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 -- to recognise completion of a COMPLETE set efficiently for large enums. - - , vi_dirty :: !Bool - -- ^ Whether this 'VarInfo' needs to be checked for inhabitants because of new - -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } data PmAltConApp @@ -604,35 +604,34 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI x pos neg bot cache dirty) - = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache, pp_dirty])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache])) where pp_x = ppr x <> dcolon <> ppr (idType x) pp_pos | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton | otherwise = char '~' <> ppr pos pp_neg = char '≁' <> ppr neg - pp_dirty | dirty = text "dirty" - | otherwise = empty -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet -- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we --- incrementally add local type constraints to. -newtype TyState = TySt InertSet +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of -- canonical (i.e. mutually compatible) term and type constraints that form the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae12890cf0c6ba7610c36b78163a9f61b76877e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ae12890cf0c6ba7610c36b78163a9f61b76877e You're receiving 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 16 12:01:59 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 16 Sep 2020 08:01:59 -0400 Subject: [Git][ghc/ghc][wip/T16762] 111 commits: Do not print synonyms in :i (->), :i Type (#18594) Message-ID: <5f61feb7a621d_80bf39a4b812427937@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 6402e67f by Ryan Scott at 2020-09-16T08:01:09-04:00 WIP: T16762 [ci skip] - - - - - 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/Dwarf.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/Class.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8767ff95effa4a3d8d8859d3be04a209664d08b1...6402e67f5c3278cc496326d2d4688592cfb0d4e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8767ff95effa4a3d8d8859d3be04a209664d08b1...6402e67f5c3278cc496326d2d4688592cfb0d4e2 You're receiving 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 16 12:29:32 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Sep 2020 08:29:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18677 Message-ID: <5f62052c8d1eb_80b3f8486465920124336b2@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T18677 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18677 You're receiving 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 16 13:15:08 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 09:15:08 -0400 Subject: [Git][ghc/ghc][wip/T18249] More fixes Message-ID: <5f620fdccfb04_80b84a627812452154@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: d0342130 by Sebastian Graf at 2020-09-16T15:14:58+02:00 More fixes - - - - - 2 changed files: - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -928,7 +928,7 @@ checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do matched <- addPhiCtNablas inc (PhiCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } @@ -940,7 +940,7 @@ checkGrd grd = CA $ \inc -> case grd of -- 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) + 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 } @@ -949,9 +949,10 @@ checkGrd grd = CA $ \inc -> case grd of !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - -- tracePm "checkGrd:Con" (ppr inc $$ ppr grd $$ ppr con_cts $$ ppr matched) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -97,8 +97,8 @@ tracePm herald doc = do {-# INLINE tracePm #-} -- see Note [INLINE conditional tracing utilities] debugOn :: () -> Bool -debugOn _ = False --- debugOn _ = True +-- debugOn _ = False +debugOn _ = True trc :: String -> SDoc -> a -> a trc | debugOn () = pprTrace @@ -280,8 +280,8 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do , ppr fuel ] runMaybeT $ do - addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) - -- inhabitationTest fuel (nabla_ty_st nabla) nabla' + nabla' <- addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) + inhabitationTest fuel (nabla_ty_st nabla) nabla' Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited {- Note [Strict fields and variables of unlifted type] @@ -953,16 +953,16 @@ addNotConCt nabla x nalt = do -- 2. Only record the new fact when it's not already implied by one of the -- solutions let implies nalt sol = eqPmAltCon (paca_con sol) nalt == Disjoint - let (neg_changed, neg') - | any (implies nalt) pos = (False, neg) + let neg' + | any (implies nalt) pos = neg -- See Note [Completeness checking with required Thetas] - | hasRequiredTheta nalt = (False, neg) - | otherwise = (True, extendPmAltConSet neg nalt) + | hasRequiredTheta nalt = neg + | otherwise = extendPmAltConSet neg nalt MASSERT( isPmAltConMatchStrict nalt ) let vi' = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor case nalt of - PmAltConLike cl | neg_changed -> do + PmAltConLike cl -> do -- Mark dirty to force a delayed inhabitation test rcm' <- lift (markMatched cl rcm) pure (Just x', vi'{ vi_rcm = rcm' }) @@ -1082,16 +1082,16 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = do | otherwise = traverseDirty -- We have to start the inhabitation test with a Nabla where all dirty bits -- are cleared - ts' <- trv_dirty (test_one nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} }) ts + ts' <- trv_dirty (test_one nabla) ts pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} where test_one :: Nabla -> VarInfo -> MaybeT DsM VarInfo - test_one nabla vi = + test_one nabla vi = do lift (varNeedsTesting old_ty_st nabla vi) >>= \case True -> do -- No solution yet and needs testing _trcM "instantiate one" (ppr vi) - instantiate (fuel-1) nabla vi + instantiate (fuel-1) nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } vi _ -> pure vi -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. @@ -1111,7 +1111,7 @@ varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ -- Same type state => still inhabited - | tyStateChanged old_ty_st new_ty_st = pure False + | not (tyStateChanged old_ty_st new_ty_st) = pure False varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do (_, _, old_rep_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) (_, _, new_rep_ty) <- tntrGuts <$> pmTopNormaliseType new_ty_st (idType $ vi_id vi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d034213026e9c090ad4e796b196174142fa0ec34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d034213026e9c090ad4e796b196174142fa0ec34 You're receiving 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 16 13:22:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 09:22:29 -0400 Subject: [Git][ghc/ghc][wip/T18249] More fixes Message-ID: <5f6211958e373_80b3f840e84da10124541ac@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 4fcd9422 by Sebastian Graf at 2020-09-16T15:22:18+02:00 More fixes - - - - - 2 changed files: - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -928,7 +928,7 @@ checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do matched <- addPhiCtNablas inc (PhiCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } @@ -940,7 +940,7 @@ checkGrd grd = CA $ \inc -> case grd of -- 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) + 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 } @@ -949,9 +949,10 @@ checkGrd grd = CA $ \inc -> case grd of !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - -- tracePm "checkGrd:Con" (ppr inc $$ ppr grd $$ ppr con_cts $$ ppr matched) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -280,8 +280,8 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do , ppr fuel ] runMaybeT $ do - addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) - -- inhabitationTest fuel (nabla_ty_st nabla) nabla' + nabla' <- addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) + inhabitationTest fuel (nabla_ty_st nabla) nabla' Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited {- Note [Strict fields and variables of unlifted type] @@ -953,16 +953,16 @@ addNotConCt nabla x nalt = do -- 2. Only record the new fact when it's not already implied by one of the -- solutions let implies nalt sol = eqPmAltCon (paca_con sol) nalt == Disjoint - let (neg_changed, neg') - | any (implies nalt) pos = (False, neg) + let neg' + | any (implies nalt) pos = neg -- See Note [Completeness checking with required Thetas] - | hasRequiredTheta nalt = (False, neg) - | otherwise = (True, extendPmAltConSet neg nalt) + | hasRequiredTheta nalt = neg + | otherwise = extendPmAltConSet neg nalt MASSERT( isPmAltConMatchStrict nalt ) let vi' = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor case nalt of - PmAltConLike cl | neg_changed -> do + PmAltConLike cl -> do -- Mark dirty to force a delayed inhabitation test rcm' <- lift (markMatched cl rcm) pure (Just x', vi'{ vi_rcm = rcm' }) @@ -1082,16 +1082,16 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = do | otherwise = traverseDirty -- We have to start the inhabitation test with a Nabla where all dirty bits -- are cleared - ts' <- trv_dirty (test_one nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} }) ts + ts' <- trv_dirty (test_one nabla) ts pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} where test_one :: Nabla -> VarInfo -> MaybeT DsM VarInfo - test_one nabla vi = + test_one nabla vi = do lift (varNeedsTesting old_ty_st nabla vi) >>= \case True -> do -- No solution yet and needs testing _trcM "instantiate one" (ppr vi) - instantiate (fuel-1) nabla vi + instantiate (fuel-1) nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } vi _ -> pure vi -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. @@ -1111,7 +1111,7 @@ varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ -- Same type state => still inhabited - | tyStateChanged old_ty_st new_ty_st = pure False + | not (tyStateChanged old_ty_st new_ty_st) = pure False varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do (_, _, old_rep_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) (_, _, new_rep_ty) <- tntrGuts <$> pmTopNormaliseType new_ty_st (idType $ vi_id vi) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fcd94221810e6d28446763031e28c87f97fa801 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fcd94221810e6d28446763031e28c87f97fa801 You're receiving 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 16 14:03:39 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 10:03:39 -0400 Subject: [Git][ghc/ghc][wip/T18249] Important micro-optimisation Message-ID: <5f621b3bc64d7_80b5933f28124627c8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: f6bc215f by Sebastian Graf at 2020-09-16T16:03:29+02:00 Important micro-optimisation - - - - - 1 changed file: - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -1078,20 +1078,20 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = do , text "tyStateChanged:" <+> ppr (tyStateChanged old_ty_st (nabla_ty_st nabla)) ] -- When type state didn't change, we only need to traverse dirty VarInfos - let trv_dirty | tyStateChanged old_ty_st (nabla_ty_st nabla) = traverseAll - | otherwise = traverseDirty - -- We have to start the inhabitation test with a Nabla where all dirty bits - -- are cleared - ts' <- trv_dirty (test_one nabla) ts + ts' <- if tyStateChanged old_ty_st (nabla_ty_st nabla) + then traverseAll test_one ts + else traverseDirty test_one ts pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} where - test_one :: Nabla -> VarInfo -> MaybeT DsM VarInfo - test_one nabla vi = do + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } + test_one :: VarInfo -> MaybeT DsM VarInfo + test_one vi = do lift (varNeedsTesting old_ty_st nabla vi) >>= \case True -> do -- No solution yet and needs testing _trcM "instantiate one" (ppr vi) - instantiate (fuel-1) nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } vi + -- We have to test with a Nabla where all dirty bits are cleared + instantiate (fuel-1) nabla_not_dirty vi _ -> pure vi -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. @@ -1102,8 +1102,6 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = do -- 3. Otherwise, if the type state didn't change, we don't need to test. -- 4. If the type state changed, we compare representation types. No need -- to test if unchanged. --- 5. If all the constructors of a TyCon are vanilla, we don't have to test. --- "vanilla" = No strict fields and no Theta. varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool varNeedsTesting _ _ vi | notNull (vi_pos vi) = pure False @@ -1117,17 +1115,7 @@ varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do (_, _, new_rep_ty) <- tntrGuts <$> pmTopNormaliseType new_ty_st (idType $ vi_id vi) if old_rep_ty `eqType` new_rep_ty then pure False - else case splitTyConApp_maybe new_rep_ty of - Just (tc, _args) - | Just dcs <- tyConDataCons_maybe tc - -> pure (atLength (any non_vanilla_dc) True dcs 10) - _ -> pure True - where - non_vanilla_dc :: DataCon -> Bool - non_vanilla_dc con = - notNull (dataConTheta con) || -- (1) - notNull (dataConImplBangs con) -- (2) - + else pure True -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle @@ -1209,6 +1197,12 @@ instCompleteSet fuel nabla x cs go :: Nabla -> [ConLike] -> MaybeT DsM Nabla go _ [] = mzero + go nabla (RealDataCon dc:_) + -- micro-optimisation, shaves down -7% allocations for PmSeriesG + -- Recall that dc can't be in vi_neg, because then it would be + -- deleted from the residual COMPLETE set. + | isDataConTriviallyInhabited dc + = pure nabla go nabla (con:cons) = do let x = vi_id vi let recur_not_con = do @@ -1219,7 +1213,12 @@ instCompleteSet fuel nabla x cs <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. - +-- | Is this 'DataCon' trivially inhabited, that is, without needing to perform +-- any inhabitation testing because of strict fields or type equalities? +isDataConTriviallyInhabited :: DataCon -> Bool +isDataConTriviallyInhabited dc = + null (dataConTheta dc) && -- (1) + null (dataConImplBangs dc) -- (2) -------------------------------------- -- * Term oracle unification procedure View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6bc215f58bb94dbe8f5dd48e6fdba8cb4b21475 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6bc215f58bb94dbe8f5dd48e6fdba8cb4b21475 You're receiving 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 16 15:04:30 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 16 Sep 2020 11:04:30 -0400 Subject: [Git][ghc/ghc][wip/T16762] WIP: T16762 Message-ID: <5f62297ebc585_80b3f84962adc94124644a9@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: ccfb61b2 by Ryan Scott at 2020-09-16T11:01:07-04:00 WIP: T16762 [ci skip] - - - - - 26 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.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/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/Expr.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/Tc/Utils/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccfb61b218e524ec5756b1c79b2afc984e7543b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccfb61b218e524ec5756b1c79b2afc984e7543b6 You're receiving 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 16 16:16:38 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Sep 2020 12:16:38 -0400 Subject: [Git][ghc/ghc][wip/T18126] 17 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f623a66b2a92_80b3f83f25dba141247007f@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 95c8e9fc by Simon Peyton Jones at 2020-09-16T17:15:34+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - f4f40866 by Simon Peyton Jones at 2020-09-16T17:15:57+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 - - - - - 5b706077 by Ben Gamari at 2020-09-16T17:15:57+01:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 29 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.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/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43d23602964995288e2b2683b9f16faddd8d7b5b...5b706077bc7b82a71c1c6d003a3946c08f517450 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43d23602964995288e2b2683b9f16faddd8d7b5b...5b706077bc7b82a71c1c6d003a3946c08f517450 You're receiving 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 16 16:30:13 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 12:30:13 -0400 Subject: [Git][ghc/ghc][wip/T18249] Reorder stuff and get documentation in order Message-ID: <5f623d9524cea_80b3f83f39eeb00124774eb@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 88b71323 by Sebastian Graf at 2020-09-16T18:30:00+02:00 Reorder stuff and get documentation in order - - - - - 1 changed file: - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -13,7 +13,7 @@ Authors: George Karachalias -- -- 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'. +-- E.g., it represents refinement types directly as a normalised refinement type 'Nabla'. module GHC.HsToCore.PmCheck.Oracle ( DsM, tracePm, mkPmId, @@ -115,7 +115,7 @@ mkPmId ty = getUniqueM >>= \unique -> in return (mkLocalIdOrCoVar name Many ty) ----------------------------------------------- --- * Caching possible matches of a COMPLETE set +-- * Caching residual COMPLETE set -- See Note [Implementation of COMPLETE pragmas] @@ -222,116 +222,6 @@ 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 - --- | Instantiate a 'ConLike' given its universal type arguments. Instantiates --- existential and term binders with fresh variables of appropriate type. --- Returns instantiated type and term variables from the match, type evidence --- and the types of strict constructor fields. -instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla --- * 'con' K is a ConLike --- - In the case of DataCons and most PatSynCons, these --- are associated with a particular TyCon T --- - But there are PatSynCons for this is not the case! See #11336, #17112 --- --- * 'arg_tys' tys are the types K's universally quantified type --- variables should be instantiated to. --- - For DataCons and most PatSyns these are the arguments of their TyCon --- - For cases like the PatSyns in #11336, #17112, we can't easily guess --- these, so don't call this function. --- --- After instantiating the universal tyvars of K to tys we get --- K @tys :: forall bs. Q => s1 .. sn -> T tys --- Note that if K is a PatSynCon, depending on arg_tys, T might not necessarily --- be a concrete TyCon. --- --- Suppose y1 is a strict field. Then we get --- Results: bs --- [y1,..,yn] --- Q --- [s1] -instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do - env <- dsGetFamInstEnvs - src_ty <- normalisedSourceType <$> pmTopNormaliseType ty_st (idType x) - let mb_arg_tys = guessConLikeUnivTyArgsFromResTy env src_ty con - case mb_arg_tys of - Just arg_tys -> do - let (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta, field_tys, _con_res_ty) - = conLikeFullSig con - -- Substitute universals for type arguments - let subst_univ = zipTvSubst univ_tvs arg_tys - -- Instantiate fresh existentials as arguments to the constructor. This is - -- important for instantiating the Thetas and field types. - (subst, _) <- cloneTyVarBndrs subst_univ ex_tvs <$> getUniqueSupplyM - let field_tys' = substTys subst $ map scaledThing field_tys - -- Instantiate fresh term variables as arguments to the constructor - arg_ids <- mapM mkPmId field_tys' - -- All constraints bound by the constructor (alpha-renamed), these are added - -- to the type oracle - let gammas = substTheta subst (eqSpecPreds eq_spec ++ thetas) - -- Finally add everything to nabla - tracePm "instCon" $ vcat - [ ppr x <+> dcolon <+> ppr (idType x) - , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty - , ppr (zipWith (\tv ty -> ppr tv <+> char '↦' <+> ppr ty) univ_tvs arg_tys) - , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) - , ppr fuel - ] - runMaybeT $ do - nabla' <- addPhiCt nabla (PhiConCt x (PmAltConLike con) ex_tvs gammas arg_ids) - inhabitationTest fuel (nabla_ty_st nabla) nabla' - Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited - -{- Note [Strict fields and variables of unlifted type] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Binders of unlifted type (and strict fields) are unlifted by construction; -they are conceived with an implicit @≁⊥@ constraint to begin with. Hence, -desugaring in "GHC.HsToCore.PmCheck" is entirely unconcerned by strict fields, -since the forcing happens *before* pattern matching. - - 1. But for each strict (or more generally, unlifted) field @s@ we have to add - @s ≁ ⊥@ constraints when we check the PmCon guard in - 'GHC.HsToCore.PmCheck.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 _ = () - - 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 - 'phiConCts'). 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. - - 2. Similarly, when performing the inhabitation test ('ensureInhabited'), - when instantiating a constructor in 'instCon', we have to generate - the appropriate unliftedness constraints and hence call 'phiConCts'. - - 3. TODO - -While the calls to 'phiConCts' in 1. and 2. seem disconnected at first, it -makes sense when drawing the connection to the paper: Figure 7 desugars -higher-level φ constraints to lower-level δ constraints and 'phiConCts' is -exactly the desugaring of a φ constructor constraint, which are generated by -the coverage checking functions A and U ('checkGrd') as well as the -inhabitation test \(∇ ⊢ x inh\) in Figure 7 ('ensureInhabited'). -Currently, this implementation just lacks a separate type for φ constraints. --} - -------------------------- --- * Pattern match oracle - -------------------------------- --- * Oracle transition function - ----------------------- -- * Type normalisation @@ -568,140 +458,6 @@ pmTopNormaliseType, using the constraint solver to solve for any local equalities (such as i ~ Int) that may be in scope. -} ----------------- --- * Type oracle - --- | Allocates a fresh 'EvVar' name for 'PredTy's. -nameTyCt :: PredType -> DsM EvVar -nameTyCt pred_ty = do - unique <- getUniqueM - let occname = mkVarOccFS (fsLit ("pm_"++show unique)) - idname = mkInternalName unique occname noSrcSpan - return (mkLocalIdOrCoVar idname Many pred_ty) - --- | Add some extra type constraints to the 'TyState'; return 'Nothing' if we --- find a contradiction (e.g. @Int ~ Bool@). -tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) -tyOracle ty_st@(TySt n inert) cts - | isEmptyBag cts - = pure (Just ty_st) - | otherwise - = do { evs <- traverse nameTyCt cts - ; tracePm "tyOracle" (ppr cts $$ ppr inert) - ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs - ; case res of - -- return the new inert set and increment the sequence number n - Just mb_new_inert -> return (TySt (n+1) <$> mb_new_inert) - Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } - -{- ********************************************************************* -* * - DIdEnv with sharing -* * -********************************************************************* -} - - -{- ********************************************************************* -* * - TmState - What we know about terms -* * -********************************************************************* -} - -{- Note [The Pos/Neg invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Invariant applying to each VarInfo: Whenever we have @(C, [y,z])@ in 'vi_pos', -any entry in 'vi_neg' must be incomparable to C (return Nothing) according to -'eqPmAltCons'. Those entries that are comparable either lead to a refutation -or are redundant. Examples: -* @x ~ Just y@, @x ≁ [Just]@. 'eqPmAltCon' returns @Equal@, so refute. -* @x ~ Nothing@, @x ≁ [Just]@. 'eqPmAltCon' returns @Disjoint@, so negative - info is redundant and should be discarded. -* @x ~ I# y@, @x ≁ [4,2]@. 'eqPmAltCon' returns @PossiblyOverlap@, so orthogal. - We keep this info in order to be able to refute a redundant match on i.e. 4 - later on. - -This carries over to pattern synonyms and overloaded literals. Say, we have - pattern Just42 = Just 42 - case Just42 of x - Nothing -> () - Just _ -> () -Even though we had a solution for the value abstraction called x here in form -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_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. - -Note [Why record both positive and negative info?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -You might think that knowing positive info (like x ~ Just y) would render -negative info irrelevant, but not so because of pattern synonyms. E.g we might -know that x cannot match (Foo 4), where pattern Foo p = Just p - -Also overloaded literals themselves behave like pattern synonyms. E.g if -postively we know that (x ~ I# y), we might also negatively want to record that -x does not match 45 f 45 = e2 f (I# 22#) = e3 f 45 = e4 -- -Overlapped - -Note [TmState invariants] -~~~~~~~~~~~~~~~~~~~~~~~~~ -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_rcm to - detect this, but we could just compare whole COMPLETE sets to vi_neg every - time, if it weren't for performance. - -Maintaining these invariants in 'addVarCt' (the core of the term oracle) and -'addNotConCt' is subtle. -* Merging VarInfos. Example: Add the fact @x ~ y@ (see 'equate'). - - (COMPLETE) If we had @x ≁ True@ and @y ≁ False@, then we get - @x ≁ [True,False]@. This is vacuous by matter of comparing to the built-in - COMPLETE set, so should refute. - - (Pos/Neg) If we had @x ≁ True@ and @y ~ True@, we have to refute. -* Adding positive information. Example: Add the fact @x ~ K ys@ (see 'addConCt') - - (Neg) If we had @x ≁ K@, refute. - - (Pos) If we had @x ~ K2@, and that contradicts the new solution according to - 'eqPmAltCon' (ex. K2 is [] and K is (:)), then refute. - - (Refine) If we had @x ≁ K zs@, unify each y with each z in turn. -* Adding negative information. Example: Add the fact @x ≁ Nothing@ (see 'addNotConCt') - - (Refut) If we have @x ~ K ys@, refute. - - (COMPLETE) If K=Nothing and we had @x ≁ Just@, then we get - @x ≁ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in - COMPLETE set, so should refute. - -Note that merging VarInfo in equate can be done by calling out to 'addConCt' and -'addNotConCt' for each of the facts individually. - -Note [Representation of Strings in TmState] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Instead of treating regular String literals as a PmLits, we treat it as a list -of characters in the oracle for better overlap reasoning. The following example -shows why: - - f :: String -> () - f ('f':_) = () - f "foo" = () - f _ = () - -The second case is redundant, and we like to warn about it. Therefore either -the oracle will have to do some smart conversion between the list and literal -representation or treat is as the list it really is at runtime. - -The "smart conversion" has the advantage of leveraging the more compact literal -representation wherever possible, but is really nasty to get right with negative -equalities: Just think of how to encode @x /= "foo"@. -The "list" option is far simpler, but incurs some overhead in representation and -warning messages (which can be alleviated by someone with enough dedication). --} - ----------------------- -- * Looking up VarInfo @@ -709,17 +465,13 @@ 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 { vi_id = x , vi_pos = [] , vi_neg = emptyPmAltConSet - , vi_bot = MaybeBot + -- Case (3) in Note [Strict fields and fields of unlifted type] + , vi_bot = if isUnliftedType (idType x) then IsNotBot else MaybeBot , vi_rcm = emptyRCM } @@ -747,6 +499,13 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing +trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x + = set_vi <$> f (lookupVarInfo ts x) + where + set_vi (a, vi') = + (a, nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env (vi_id vi') vi' } }) + ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -802,6 +561,8 @@ lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of ------------------------- -- * Adding φ constraints +-- +-- Figure 7 in the LYG paper. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. @@ -853,24 +614,9 @@ addPhiCts :: Nabla -> PhiCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. addPhiCts nabla cts = runMaybeT $ do nabla' <- addPhiCtsNoTest nabla cts + -- See Note [Delaying the inhabitation test] inhabitationTest initFuel (nabla_ty_st nabla) nabla' --- Why not always perform the inhabitation test immediately after adding type --- info? Because of infinite loops. Consider --- --- f :: a :~: Int -> b :~: Bool -> a -> b -> () --- f !x !y !_ !_ | False = () --- --- The ≁⊥ constraint on the x will need an inhabitation test, --- which instantiates to the GADT constructor Refl. We add its Theta to the --- type state and perform an inhabitation test on *all* other variables. --- When testing y, we similarly instantiate the GADT constructor Refl. --- That will add *its* Theta to the type state and perform an inhabtiation test --- for all other variables, including x. And so on, and infinite loop. --- --- So we perform the inhabitation test once after having added all constraints --- that we wanted to add. - -- | Add 'PmCts' ('addPhiCts') without performing an inhabitation test by -- instantiation afterwards. Very much for internal use only! addPhiCtsNoTest :: Nabla -> PhiCts -> MaybeT DsM Nabla @@ -878,7 +624,7 @@ addPhiCtsNoTest :: Nabla -> PhiCts -> MaybeT DsM Nabla addPhiCtsNoTest nabla cts = do let (ty_cts, tm_cts) = partitionPhiCts cts nabla' <- addTyCts nabla (listToBag ty_cts) - foldlM addPhiCt nabla' (listToBag tm_cts) + foldlM addPhiTmCt nabla' (listToBag tm_cts) partitionPhiCts :: PhiCts -> ([PredType], [PhiCt]) partitionPhiCts = partitionEithers . map to_either . toList @@ -886,6 +632,9 @@ partitionPhiCts = partitionEithers . map to_either . toList to_either (PhiTyCt pred_ty) = Left pred_ty to_either ct = Right ct +----------------------------- +-- ** Adding type constraints + -- | Adds new type-level constraints by calling out to the type-checker via -- 'tyOracle'. addTyCts :: Nabla -> Bag PredType -> MaybeT DsM Nabla @@ -893,6 +642,32 @@ addTyCts nabla at MkNabla{ nabla_ty_st = ty_st } new_ty_cs = do ty_st' <- MaybeT (tyOracle ty_st new_ty_cs) pure nabla{ nabla_ty_st = ty_st' } +-- | Add some extra type constraints to the 'TyState'; return 'Nothing' if we +-- find a contradiction (e.g. @Int ~ Bool@). +tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) +tyOracle ty_st@(TySt n inert) cts + | isEmptyBag cts + = pure (Just ty_st) + | otherwise + = do { evs <- traverse nameTyCt cts + ; tracePm "tyOracle" (ppr cts $$ ppr inert) + ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs + ; case res of + -- return the new inert set and increment the sequence number n + Just mb_new_inert -> return (TySt (n+1) <$> mb_new_inert) + Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } + +-- | Allocates a fresh 'EvVar' name for 'PredTy's. +nameTyCt :: PredType -> DsM EvVar +nameTyCt pred_ty = do + unique <- getUniqueM + let occname = mkVarOccFS (fsLit ("pm_"++show unique)) + idname = mkInternalName unique occname noSrcSpan + return (mkLocalIdOrCoVar idname Many pred_ty) + +----------------------------- +-- ** Adding term constraints + -- | Adds a single higher-level φ constraint by dispatching to the various -- oracle functions. -- @@ -901,24 +676,27 @@ addTyCts nabla at MkNabla{ nabla_ty_st = ty_st } new_ty_cs = do -- into lower-level δ constraints. We don't have a data type for δ constraints -- and call the corresponding oracle function directly instead. -- --- Precondition: The φ is not a type constraint! These should be handled by +-- Precondition: The φ is /not/ a type constraint! These should be handled by -- 'addTyCts' before, through 'addPhiCts'. -addPhiCt :: Nabla -> PhiCt -> MaybeT DsM Nabla -addPhiCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiCt nabla (PhiCoreCt x e) = addCoreCt nabla x e -addPhiCt nabla (PhiConCt x con tvs dicts args) = do +addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla +addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition +addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do + -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. nabla' <- addTyCts nabla (listToBag dicts) nabla'' <- addConCt nabla' x con tvs args - let unlifted_fields = - [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || isUnliftedType (idType arg) ] - foldlM addNotBotCt nabla'' unlifted_fields -addPhiCt nabla (PhiNotConCt x con) = addNotConCt nabla x con -addPhiCt nabla (PhiBotCt x) = addBotCt nabla x -addPhiCt nabla (PhiNotBotCt x) = addNotBotCt nabla x + foldlM addNotBotCt nabla'' (filterUnliftedFields con args) +addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con +addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x +addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x + +filterUnliftedFields :: PmAltCon -> [Id] -> [Id] +filterUnliftedFields con args = + [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || isUnliftedType (idType arg) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about @@ -926,6 +704,7 @@ addPhiCt nabla (PhiNotBotCt x) = addNotBotCt nabla x addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + lift $ tracePm "addBotCt" (ppr y $$ ppr vi) case bot of IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do @@ -933,6 +712,20 @@ addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do let vi' = vi{ vi_bot = IsBot } pure nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env y vi' } } +-- | 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 = ts at TmSt{ts_facts=env} } 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 + -- Mark dirty for a delayed inhabitation test + let vi' = vi{ vi_bot = IsNotBot} + pure $ markDirty y + $ nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env y vi' } } + -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. @@ -975,12 +768,359 @@ hasRequiredTheta (PmAltConLike cl) = notNull req_theta (_,_,_,_,req_theta,_,_) = conLikeFullSig cl hasRequiredTheta _ = False -{- Note [Completeness checking with required Thetas] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the situation in #11224 - - import Text.Read (readMaybe) - pattern PRead :: Read a => () => a -> String +-- | Add a @x ~ K tvs args ts@ constraint. +-- @addConCt x K tvs args ts@ extends the substitution with a solution +-- @x :-> (K, tvs, args)@ if compatible with the negative and positive info we +-- have on @x@, reject (@Nothing@) otherwise. +-- +-- See Note [TmState invariants]. +addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do + let vi@(VI _ pos neg bot _) = 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 + -- additional refinement of the possible values x could take) indicate a + -- contradiction + guard (all ((/= Disjoint) . eqPmAltCon alt . paca_con) pos) + -- Now we should be good! Add (alt, tvs, args) as a possible solution, or + -- refine an existing one + case find ((== Equal) . eqPmAltCon alt . paca_con) pos of + Just (PACA _con other_tvs other_args) -> do + -- We must unify existentially bound ty vars and arguments! + let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) + when (length args /= length other_args) $ + lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) + nabla' <- addPhiCtsNoTest nabla (listToBag ty_cts) + let add_var_ct nabla (a, b) = addVarCt nabla a b + foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args + Nothing -> do + let pos' = PACA alt tvs args : pos + let nabla_with bot' = + nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})} } + -- 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] -> [PhiCt] +equateTys ts us = + [ PhiTyCt (mkPrimEqPred t u) + | (t, u) <- zipEqual "equateTys" ts us + -- The following line filters out trivial Refl constraints, so that we don't + -- need to initialise the type oracle that often + , not (eqType t u) + ] + +-- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the +-- gained knowledge in 'Nabla'. +-- +-- 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 :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt nabla at MkNabla{ nabla_tm_st = TmSt{ ts_facts = 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 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. +-- Makes sure that the positive and negative facts of @x@ and @y@ are +-- compatible. +-- Preconditions: @not (sameRepresentativeSDIE env x y)@ +-- +-- See Note [TmState invariants]. +equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla +equate nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x y + = ASSERT( not (sameRepresentativeSDIE env x y) ) + case (lookupSDIE env x, lookupSDIE env y) of + (Nothing, _) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env x y } }) + (_, Nothing) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env y x } }) + -- 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... + -- We should decide how to break the tie + MASSERT2( idType (vi_id vi_x) `eqType` idType (vi_id vi_y), text "Not same type" ) + -- First assume that x and y are in the same equivalence class + let env_ind = setIndirectSDIE env x y + -- Then sum up the refinement counters + let env_refs = setEntrySDIE env_ind y vi_y + let nabla_refs = nabla{ nabla_tm_st = ts{ts_facts = env_refs} } + -- and then gradually merge every positive fact we have on x into y + let add_fact nabla (PACA 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 nabla nalt = addNotConCt nabla y nalt + nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) + -- vi_rcm will be updated in addNotConCt, so we are good to + -- go! + pure nabla_neg + +-- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based +-- on the shape of the 'CoreExpr' @e at . Examples: +-- +-- * For @let x = Just (42, 'z')@ we want to record the +-- constraints @x ~ Just a, a ~ (b, c), b ~ 42, c ~ 'z'@. +-- See 'data_con_app'. +-- * For @let x = unpackCString# "tmp"@ we want to record the literal +-- constraint @x ~ "tmp"@. +-- * For @let x = I# 42@ we want the literal constraint @x ~ 42 at . Similar +-- 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 :: 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') 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 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 + -- syntax). See Note [COMPLETE sets on data families] + -- core_expr x e | pprTrace "core_expr" (ppr x $$ ppr e) False = undefined + core_expr x (Cast e _co) = core_expr x e + core_expr x (Tick _t e) = core_expr x e + core_expr x e + | Just (pmLitAsStringLit -> Just s) <- coreExprAsPmLit e + , expr_ty `eqType` stringTy + -- See Note [Representation of Strings in TmState] + = case unpackFS s of + -- We need this special case to break a loop with coreExprAsPmLit + -- Otherwise we alternate endlessly between [] and "" + [] -> data_con_app x emptyInScopeSet nilDataCon [] + s' -> core_expr x (mkListExpr charTy (map mkCharExpr s')) + | Just lit <- coreExprAsPmLit e + = pm_lit x lit + | Just (in_scope, _empty_floats@[], dc, _arg_tys, args) + <- exprIsConApp_maybe in_scope_env e + = data_con_app x in_scope dc args + -- See Note [Detecting pattern synonym applications in expressions] + | Var y <- e, Nothing <- isDataConId_maybe x + -- We don't consider DataCons flexible variables + = 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! + = equate_with_similar_expr x e + where + expr_ty = exprType e + expr_in_scope = mkInScopeSet (exprFreeVars e) + in_scope_env = (expr_in_scope, const NoUnfolding) + -- It's inconvenient to get hold of a global in-scope set + -- here, but it'll only be needed if exprIsConApp_maybe ends + -- up substituting inside a forall or lambda (i.e. seldom) + -- so using exprFreeVars seems fine. See MR !1647. + + -- | The @e@ in @let x = e@ had no familiar form. But we can still see if + -- 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 Nabla (MaybeT DsM) () + equate_with_similar_expr x e = do + rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) + -- Note that @rep == x@ if we encountered @e@ for the first time. + modifyT (\nabla -> addVarCt nabla x rep) + + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id + bind_expr e = do + x <- lift (lift (mkPmId (exprType e))) + core_expr x e + pure x + + -- | Look at @let x = K taus theta es@ and generate the following + -- constraints (assuming universals were dropped from @taus@ before): + -- 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 + (ex_ty_args, val_args) = splitAtList dc_ex_tvs args + ex_tys = map exprToType ex_ty_args + vis_args = reverse $ take arty $ reverse val_args + 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. @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 -> addPhiCtsNoTest nabla (listToBag ty_cts) + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + arg_ids <- traverse bind_expr vis_args + -- 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 . + -- 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 Nabla (MaybeT DsM) () + pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args + +-- | 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 +-- equivalent to @e'@) we encountered earlier, or a fresh identifier if +-- there weren't any such constraints. +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 nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } + pure (nabla', rep) + +-- | Like 'modify', but with an effectful modifier action +modifyT :: Monad m => (s -> m s) -> StateT s m () +modifyT f = StateT $ fmap ((,) ()) . f + +{- Note [The Pos/Neg invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant applying to each VarInfo: Whenever we have @C @tvs args@ in 'vi_pos', +any entry in 'vi_neg' must be incomparable to C (return Nothing) according to +'eqPmAltCons'. Those entries that are comparable either lead to a refutation +or are redundant. Examples: +* @x ~ Just y@, @x ≁ [Just]@. 'eqPmAltCon' returns @Equal@, so refute. +* @x ~ Nothing@, @x ≁ [Just]@. 'eqPmAltCon' returns @Disjoint@, so negative + info is redundant and should be discarded. +* @x ~ I# y@, @x ≁ [4,2]@. 'eqPmAltCon' returns @PossiblyOverlap@, so orthogal. + We keep this info in order to be able to refute a redundant match on i.e. 4 + later on. + +This carries over to pattern synonyms and overloaded literals. Say, we have + pattern Just42 = Just 42 + case Just42 of x + Nothing -> () + Just _ -> () +Even though we had a solution for the value abstraction called x here in form +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_rcm, which essentially stores 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. + +Note [Why record both positive and negative info?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +You might think that knowing positive info (like x ~ Just y) would render +negative info irrelevant, but not so because of pattern synonyms. E.g we might +know that x cannot match (Foo 4), where pattern Foo p = Just p + +Also overloaded literals themselves behave like pattern synonyms. E.g if +postively we know that (x ~ I# y), we might also negatively want to record that +x does not match 45 f 45 = e2 f (I# 22#) = e3 f 45 = e4 -- +Overlapped + +Note [TmState invariants] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The term oracle state is never obviously (i.e., without consulting the type +oracle or doing inhabitation testing) 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_rcm to + detect this, but we could just compare whole COMPLETE sets to vi_neg every + time, if it weren't for performance. + +Maintaining these invariants in 'addVarCt' (the core of the term oracle) and +'addNotConCt' is subtle. +* Merging VarInfos. Example: Add the fact @x ~ y@ (see 'equate'). + - (COMPLETE) If we had @x ≁ True@ and @y ≁ False@, then we get + @x ≁ [True,False]@. This is vacuous by matter of comparing to the built-in + COMPLETE set, so should refute. + - (Pos/Neg) If we had @x ≁ True@ and @y ~ True@, we have to refute. +* Adding positive information. Example: Add the fact @x ~ K ys@ (see 'addConCt') + - (Neg) If we had @x ≁ K@, refute. + - (Pos) If we had @x ~ K2@, and that contradicts the new solution according to + 'eqPmAltCon' (ex. K2 is [] and K is (:)), then refute. + - (Refine) If we had @x ≁ K zs@, unify each y with each z in turn. +* Adding negative information. Example: Add the fact @x ≁ Nothing@ (see 'addNotConCt') + - (Refut) If we have @x ~ K ys@, refute. + - (COMPLETE) If K=Nothing and we had @x ≁ Just@, then we get + @x ≁ [Just,Nothing]@. This is vacuous by matter of comparing to the built-in + COMPLETE set, so should refute. + +Note that merging VarInfo in equate can be done by calling out to 'addConCt' and +'addNotConCt' for each of the facts individually. + +Note [Representation of Strings in TmState] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Instead of treating regular String literals as a PmLits, we treat it as a list +of characters in the oracle for better overlap reasoning. The following example +shows why: + + f :: String -> () + f ('f':_) = () + f "foo" = () + f _ = () + +The second case is redundant, and we like to warn about it. Therefore either +the oracle will have to do some smart conversion between the list and literal +representation or treat is as the list it really is at runtime. + +The "smart conversion" has the advantage of leveraging the more compact literal +representation wherever possible, but is really nasty to get right with negative +equalities: Just think of how to encode @x /= "foo"@. +The "list" option is far simpler, but incurs some overhead in representation and +warning messages (which can be alleviated by someone with enough dedication). + +Note [Detecting pattern synonym applications in expressions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At the moment we fail to detect pattern synonyms in scrutinees and RHS of +guards. This could be alleviated with considerable effort and complexity, but +the returns are meager. Consider: + + pattern P + pattern Q + case P 15 of + Q _ -> ... + P 15 -> + +Compared to the situation where P and Q are DataCons, the lack of generativity +means we could never flag Q as redundant. (also see Note [Undecidable Equality +for PmAltCons] in PmTypes.) On the other hand, if we fail to recognise the +pattern synonym, we flag the pattern match as inexhaustive. That wouldn't happen +if we had knowledge about the scrutinee, in which case the oracle basically +knows "If it's a P, then its field is 15". + +This is a pretty narrow use case and I don't think we should to try to fix it +until a user complains energetically. + +Note [Completeness checking with required Thetas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the situation in #11224 + + import Text.Read (readMaybe) + pattern PRead :: Read a => () => a -> String pattern PRead x <- (readMaybe -> Just x) f :: String -> Int f (PRead x) = x @@ -1004,46 +1144,57 @@ we no longer detect the actually redundant match in But that's a small price to pay, compared to the proper solution here involving storing required arguments along with the PmAltConLike in 'vi_neg'. --} --- | Guess the universal argument types of a ConLike from an instantiation of --- 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 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. - 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 - -- Note [Pattern synonym result type] in GHC.Core.PatSyn. So we just try our best - -- here and be sure to return an instantiation when we can substitute every - -- universally quantified type variable. - -- We *could* instantiate all the other univ_tvs just to fresh variables, I - -- suppose, but that means we get weird field types for which we don't know - -- anything. So we prefer to keep it simple here. - let (univ_tvs,_,_,_,_,con_res_ty) = patSynSig ps - subst <- tcMatchTy con_res_ty res_ty - traverse (lookupTyVar subst) univ_tvs +Note [Strict fields and variables of unlifted type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Binders of unlifted type (and strict fields) are unlifted by construction; +they are conceived with an implicit @≁⊥@ constraint to begin with. Hence, +desugaring in "GHC.HsToCore.PmCheck" is entirely unconcerned by strict fields, +since the forcing happens *before* pattern matching. +And the φ constructor constraints emitted by 'GHC.HsToCore.PmCheck.checkGrd' +have complex binding semantics (binding type constraints and unlifted fields), +so unliftedness semantics are entirely confined to the oracle. --- | 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 = ts at TmSt{ts_facts=env} } 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 - -- Mark dirty for a delayed inhabitation test - let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env y vi' } } +These are the moving parts: + + 1. For each strict (or more generally, unlifted) field @s@ of a 'PhiConCt' + we have to add a @s ≁ ⊥@ constraint in the corresponding case of + 'addPhiTmCt'. 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 _ = () + + 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 @MkT n <- x@ (Nothing surprising so far). + Upon that constraint, it disperses into two lower-level δ constraints + @x ~ MkT n, n ≁ ⊥@ per Equation (3) in Figure 7 of the paper. + + 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. + + 2. Similarly, when performing the 'inhabitationTest', when instantiating a + constructor we call 'instCon', which generates a higher-level φ + constructor constraint. + + 3. The preceding points handle unlifted constructor fields, but there also + are regular binders of unlifted type. + Since the oracle as implemented has no notion of scoping and bindings, + we can't know *when* an unlifted variable comes into scope. But that's + not actually a problem, because we can just add the @x ≁ ⊥@ to the + 'emptyVarInfo' when we first encounter it. +-} + +------------------------- +-- * Inhabitation testing +-- +-- Figure 8 in the LYG paper. tyStateChanged :: TyState -> TyState -> Bool -- Makes use of the fact that the two TyStates we compare @@ -1134,16 +1285,6 @@ instBot _fuel nabla vi = do _nabla' <- addBotCt nabla (vi_id vi) pure vi -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) - where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env (vi_id vi') vi' } }) - ---overVarInfo :: Functor f => (VarInfo -> f VarInfo) -> Nabla -> Id -> f Nabla ---overVarInfo f nabla x = snd <$> trvVarInfo (\vi -> ((),) <$> f vi) nabla x - addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x = trvVarInfo add_matches nabla x @@ -1198,7 +1339,7 @@ instCompleteSet fuel nabla x cs go :: Nabla -> [ConLike] -> MaybeT DsM Nabla go _ [] = mzero go nabla (RealDataCon dc:_) - -- micro-optimisation, shaves down -7% allocations for PmSeriesG + -- See Note [DataCons that are definitely inhabitable] -- Recall that dc can't be in vi_neg, because then it would be -- deleted from the residual COMPLETE set. | isDataConTriviallyInhabited dc @@ -1213,114 +1354,18 @@ instCompleteSet fuel nabla x cs <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. --- | Is this 'DataCon' trivially inhabited, that is, without needing to perform --- any inhabitation testing because of strict fields or type equalities? -isDataConTriviallyInhabited :: DataCon -> Bool -isDataConTriviallyInhabited dc = - null (dataConTheta dc) && -- (1) - null (dataConImplBangs dc) -- (2) - --------------------------------------- --- * Term oracle unification procedure - --- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the --- gained knowledge in 'Nabla'. --- --- 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 :: Nabla -> Id -> Id -> MaybeT DsM Nabla -addVarCt nabla at MkNabla{ nabla_tm_st = TmSt{ ts_facts = 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 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. --- Makes sure that the positive and negative facts of @x@ and @y@ are --- compatible. --- Preconditions: @not (sameRepresentativeSDIE env x y)@ --- --- See Note [TmState invariants]. -equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla -equate nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x y - = ASSERT( not (sameRepresentativeSDIE env x y) ) - case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env x y } }) - (_, Nothing) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env y x } }) - -- 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... - -- We should decide how to break the tie - MASSERT2( idType (vi_id vi_x) `eqType` idType (vi_id vi_y), text "Not same type" ) - -- First assume that x and y are in the same equivalence class - let env_ind = setIndirectSDIE env x y - -- Then sum up the refinement counters - let env_refs = setEntrySDIE env_ind y vi_y - let nabla_refs = nabla{ nabla_tm_st = ts{ts_facts = env_refs} } - -- and then gradually merge every positive fact we have on x into y - let add_fact nabla (PACA 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 nabla nalt = addNotConCt nabla y nalt - nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_rcm will be updated in addNotConCt, so we are good to - -- go! - pure nabla_neg - --- | Add a @x ~ K tvs args ts@ constraint. --- @addConCt x K tvs args ts@ extends the substitution with a solution --- @x :-> (K, tvs, args)@ if compatible with the negative and positive info we --- have on @x@, reject (@Nothing@) otherwise. --- --- See Note [TmState invariants]. -addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla -addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let vi@(VI _ pos neg bot _) = 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 - -- additional refinement of the possible values x could take) indicate a - -- contradiction - guard (all ((/= Disjoint) . eqPmAltCon alt . paca_con) pos) - -- Now we should be good! Add (alt, tvs, args) as a possible solution, or - -- refine an existing one - case find ((== Equal) . eqPmAltCon alt . paca_con) pos of - Just (PACA _con other_tvs other_args) -> do - -- We must unify existentially bound ty vars and arguments! - let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) - when (length args /= length other_args) $ - lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) - nabla' <- addPhiCtsNoTest nabla (listToBag ty_cts) - let add_var_ct nabla (a, b) = addVarCt nabla a b - foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args - Nothing -> do - let pos' = PACA alt tvs args : pos - let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})} } - -- 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 ⊥ +-- | Is this 'DataCon' trivially inhabited, that is, without needing to perform +-- any inhabitation testing because of strict/unlifted fields or type equalities? +isDataConTriviallyInhabited :: DataCon -> Bool +isDataConTriviallyInhabited dc + | isTyConTriviallyInhabited (dataConTyCon dc) = True +isDataConTriviallyInhabited dc = + null (dataConTheta dc) && -- (1) + null (dataConImplBangs dc) && -- (2) + all (not . isUnliftedType . scaledThing) (dataConOrigArgTys dc) -- (3) -equateTys :: [Type] -> [Type] -> [PhiCt] -equateTys ts us = - [ PhiTyCt (mkPrimEqPred t u) - | (t, u) <- zipEqual "equateTys" ts us - -- The following line filters out trivial Refl constraints, so that we don't - -- need to initialise the type oracle that often - , not (eqType t u) - ] +isTyConTriviallyInhabited :: TyCon -> Bool +isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons -- | All these types are trivially inhabited triviallyInhabitedTyCons :: UniqSet TyCon @@ -1328,110 +1373,98 @@ triviallyInhabitedTyCons = mkUniqSet [ charTyCon, doubleTyCon, floatTyCon, intTyCon, wordTyCon, word8TyCon ] -isTyConTriviallyInhabited :: TyCon -> Bool -isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons - ----------------------------- --- * Detecting vacuous types - -{- Note [Checking EmptyCase Expressions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Empty case expressions are strict on the scrutinee. That is, `case x of {}` -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: - -1. We normalise the outermost type family redex, data family redex or newtype, - using pmTopNormaliseType (in "GHC.Core.FamInstEnv"). This computes 3 - things: - (a) A normalised type src_ty, which is equal to the type of the scrutinee in - source Haskell (does not normalise newtypes or data families) - (b) The actual normalised type core_ty, which coincides with the result - topNormaliseType_maybe. This type is not necessarily equal to the input - type in source Haskell. And this is precicely the reason we compute (a) - and (c): the reasoning happens with the underlying types, but both the - patterns and types we print should respect newtypes and also show the - family type constructors and not the representation constructors. - - (c) A list of all newtype data constructors dcs, each one corresponding to a - newtype rewrite performed in (b). - - For an example see also Note [Type normalisation] - in "GHC.Core.FamInstEnv". - -2. Function Check.checkEmptyCase' performs the check: - - If core_ty is not an algebraic type, then we cannot check for - inhabitation, so we emit (_ :: src_ty) as missing, conservatively assuming - that the type is inhabited. - - If core_ty is an algebraic type, then we unfold the scrutinee to all - possible constructor patterns, using inhabitationCandidates, and then - check each one for constraint satisfiability, same as we do for normal - pattern match checking. --} +-- | Instantiate a 'ConLike' given its universal type arguments. Instantiates +-- existential and term binders with fresh variables of appropriate type. +-- Returns instantiated type and term variables from the match, type evidence +-- and the types of strict constructor fields. +instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla +-- * 'con' K is a ConLike +-- - In the case of DataCons and most PatSynCons, these +-- are associated with a particular TyCon T +-- - But there are PatSynCons for this is not the case! See #11336, #17112 +-- +-- * 'arg_tys' tys are the types K's universally quantified type +-- variables should be instantiated to. +-- - For DataCons and most PatSyns these are the arguments of their TyCon +-- - For cases like the PatSyns in #11336, #17112, we can't easily guess +-- these, so don't call this function. +-- +-- After instantiating the universal tyvars of K to tys we get +-- K @tys :: forall bs. Q => s1 .. sn -> T tys +-- Note that if K is a PatSynCon, depending on arg_tys, T might not necessarily +-- be a concrete TyCon. +-- +-- Suppose y1 is a strict field. Then we get +-- Results: bs +-- [y1,..,yn] +-- Q +-- [s1] +instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = MaybeT $ do + env <- dsGetFamInstEnvs + src_ty <- normalisedSourceType <$> pmTopNormaliseType ty_st (idType x) + let mb_arg_tys = guessConLikeUnivTyArgsFromResTy env src_ty con + case mb_arg_tys of + Just arg_tys -> do + let (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta, field_tys, _con_res_ty) + = conLikeFullSig con + -- Substitute universals for type arguments + let subst_univ = zipTvSubst univ_tvs arg_tys + -- Instantiate fresh existentials as arguments to the constructor. This is + -- important for instantiating the Thetas and field types. + (subst, _) <- cloneTyVarBndrs subst_univ ex_tvs <$> getUniqueSupplyM + let field_tys' = substTys subst $ map scaledThing field_tys + -- Instantiate fresh term variables as arguments to the constructor + arg_ids <- mapM mkPmId field_tys' + -- All constraints bound by the constructor (alpha-renamed), these are added + -- to the type oracle + let gammas = substTheta subst (eqSpecPreds eq_spec ++ thetas) + -- Finally add everything to nabla + tracePm "instCon" $ vcat + [ ppr x <+> dcolon <+> ppr (idType x) + , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty + , ppr (zipWith (\tv ty -> ppr tv <+> char '↦' <+> ppr ty) univ_tvs arg_tys) + , ppr gammas + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr fuel + ] + runMaybeT $ do + -- Case (2) of Note [Strict fields and variables of unlifted type] + let alt = PmAltConLike con + nabla' <- addPhiTmCt nabla (PhiConCt x alt ex_tvs gammas arg_ids) + let branching_factor = length $ filterUnliftedFields alt arg_ids + -- See Note [Fuel for the inhabitation test] + let new_fuel + | branching_factor <= 1 = fuel + | otherwise = min fuel 2 + inhabitationTest new_fuel (nabla_ty_st nabla) nabla' + Nothing -> pure (Just nabla) -- Could not guess arg_tys. Just assume inhabited -{- Note [Strict argument type constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In the ConVar case of clause processing, each conlike K traditionally -generates two different forms of constraints: - -* A term constraint (e.g., x ~ K y1 ... yn) -* Type constraints from the conlike's context (e.g., if K has type - forall bs. Q => s1 .. sn -> T tys, then Q would be its type constraints) - -As it turns out, these alone are not enough to detect a certain class of -unreachable code. Consider the following example (adapted from #15305): - - data K = K1 | K2 !Void - - f :: K -> () - f K1 = () - -Even though `f` doesn't match on `K2`, `f` is exhaustive in its patterns. Why? -Because it's impossible to construct a terminating value of type `K` using the -`K2` constructor, and thus it's impossible for `f` to ever successfully match -on `K2`. - -The reason is because `K2`'s field of type `Void` is //strict//. Because there -are no terminating values of type `Void`, any attempt to construct something -using `K2` will immediately loop infinitely or throw an exception due to the -strictness annotation. (If the field were not strict, then `f` could match on, -say, `K2 undefined` or `K2 (let x = x in x)`.) - -Since neither the term nor type constraints mentioned above take strict -argument types into account, we make use of the `nonVoid` function to -determine whether a strict type is inhabitable by a terminating value or not. -We call this the "inhabitation test". - -`nonVoid ty` returns True when either: -1. `ty` has at least one InhabitationCandidate for which both its term and type - constraints are satisfiable, and `nonVoid` returns `True` for all of the - strict argument types in that InhabitationCandidate. -2. We're unsure if it's inhabited by a terminating value. - -`nonVoid ty` returns False when `ty` is definitely uninhabited by anything -(except bottom). Some examples: - -* `nonVoid Void` returns False, since Void has no InhabitationCandidates. - (This is what lets us discard the `K2` constructor in the earlier example.) -* `nonVoid (Int :~: Int)` returns True, since it has an InhabitationCandidate - (through the Refl constructor), and its term constraint (x ~ Refl) and - type constraint (Int ~ Int) are satisfiable. -* `nonVoid (Int :~: Bool)` returns False. Although it has an - InhabitationCandidate (by way of Refl), its type constraint (Int ~ Bool) is - not satisfiable. -* Given the following definition of `MyVoid`: - - data MyVoid = MkMyVoid !Void - - `nonVoid MyVoid` returns False. The InhabitationCandidate for the MkMyVoid - constructor contains Void as a strict argument type, and since `nonVoid Void` - returns False, that InhabitationCandidate is discarded, leaving no others. -* Whether or not a type is inhabited is undecidable in general. - See Note [Fuel for the inhabitation test]. -* For some types, inhabitation is evident immediately and we don't need to - perform expensive tests. See Note [Types that are definitely inhabitable]. +-- | Guess the universal argument types of a ConLike from an instantiation of +-- its (normalised!) 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 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. + 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 + -- Note [Pattern synonym result type] in GHC.Core.PatSyn. So we just try our best + -- here and be sure to return an instantiation when we can substitute every + -- universally quantified type variable. + -- We *could* instantiate all the other univ_tvs just to fresh variables, I + -- suppose, but that means we get weird field types for which we don't know + -- anything. So we prefer to keep it simple here. + let (univ_tvs,_,_,_,_,con_res_ty) = patSynSig ps + subst <- tcMatchTy con_res_ty res_ty + traverse (lookupTyVar subst) univ_tvs +{- Note [Fuel for the inhabitation test] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Whether or not a type is inhabited is undecidable in general. As a result, we @@ -1449,16 +1482,10 @@ construct a terminating value using MkAbyss. But this can't be proven by mere instantiation and requires an inductive argument, which `inhabitationTest` currently isn't equipped to do. -In order to prevent endless instantiation attempts in @inhabitationTest@, we use -the fuel as an upper bound such attempts. +In order to prevent endless instantiation attempts in @inhabitationTest@, we +use the fuel as an upper bound such attempts. -To avoid this sort of conundrum, `nonVoid` uses a simple test to detect the -presence of recursive types (through `checkRecTc`), and if recursion is -detected, we bail out and conservatively assume that the type is inhabited by -some terminating value. This avoids infinite loops at the expense of making -the coverage checker incomplete with respect to functions like -stareIntoTheAbyss above. Then again, the same problem occurs with recursive -newtypes, like in the following code: +The same problem occurs with recursive newtypes, like in the following code: newtype Chasm = MkChasm Chasm gazeIntoTheChasm :: Chasm -> a @@ -1467,18 +1494,19 @@ newtypes, like in the following code: So this limitation is somewhat understandable. Note that even with this recursion detection, there is still a possibility that -`nonVoid` can run in exponential time. Consider the following data type: +`inhabitationTest` can run in exponential time in the amount of fuel. Consider +the following data type: data T = MkT !T !T !T -If we call `nonVoid` on each of its fields, that will require us to once again +If we try to instantiate each of its fields, that will require us to once again check if `MkT` is inhabitable in each of those three fields, which in turn will require us to check if `MkT` is inhabitable again... As you can see, the -branching factor adds up quickly, and if the recursion depth limit is, say, -100, then `nonVoid T` will effectively take forever. +branching factor adds up quickly, and if the initial fuel is, say, +100, then the inhabiation test will effectively take forever. -To mitigate this, we check the branching factor every time we are about to call -`nonVoid` on a list of strict argument types. If the branching factor exceeds 1 +To mitigate this, we check the branching factor every time we are about to do +inhabitation testing in 'instCon'. If the branching factor exceeds 1 (i.e., if there is potential for exponential runtime), then we limit the maximum recursion depth to 1 to mitigate the problem. If the branching factor is exactly 1 (i.e., we have a linear chain instead of a tree), then it's okay @@ -1487,7 +1515,7 @@ to stick with a larger maximum recursion depth. In #17977 we saw that the defaultRecTcMaxBound (100 at the time of writing) was too large and had detrimental effect on performance of the coverage checker. Given that we only commit to a best effort anyway, we decided to substantially -decrement the recursion depth to 3, at the cost of precision in some edge cases +decrement the fuel to 4, at the cost of precision in some edge cases like data Nat = Z | S Nat @@ -1499,58 +1527,45 @@ like Since the coverage won't bother to instantiate Down 4 levels deep to see that it is in fact uninhabited, it will emit a inexhaustivity warning for the case. -Note [Types that are definitely inhabitable] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Delaying the Inhabitation test] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We delay the inhabitation test that normally happens after having added +negative information or a type constraints. This has the potential to do +less inhabitation tests for φ constructor constraints, which potentially add a +bunch of ≁⊥ and type constraints at once. + +Note [DataCons that are definitely inhabitable] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Another microoptimization applies to data types like this one: data S a = S ![a] !T Even though there is a strict field of type [a], it's quite silly to call -nonVoid on it, since it's "obvious" that it is inhabitable. To make this -intuition formal, we say that a type is definitely inhabitable (DI) if: +'instCon' on it, since it's "obvious" that it is inhabitable. To make this +intuition formal, we say that a DataCon C is definitely inhabitable (DI) if: - * It has at least one constructor C such that: - 1. C has no equality constraints (since they might be unsatisfiable) - 2. C has no strict argument types (since they might be uninhabitable) + 1. C has no equality constraints (since they might be unsatisfiable) + 2. C has no strict/unlifted argument types (since they might be uninhabitable) -It's relatively cheap to check if a type is DI, so before we call `nonVoid` -on a list of strict argument types, we filter out all of the DI ones. +It's relatively cheap to check if a DataCon is DI, so before we call 'instCon' +on a constructor of a COMPLETE set, we filter out all of the DI ones. + +This fast path shaves down -7% allocations for PmSeriesG, for example. -} --------------------------------------------- --- * Providing positive evidence for a Nabla +-------------------------------------- +-- * Generating inhabitants of a Nabla +-- +-- This is important for warnings. Roughly corresponds to G in Figure 6 of the +-- LYG paper, with a few tweaks for better warning messages. -- | @generateInhabitants 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. --- --- TODO: Reasons why this can't serve as a replacment for 'ensureAllInhabited': --- * It only considers match variables, so no let-bindings (easily fixed) --- * It only splits once, when there is no positive evidence. This is for better --- warning messages; e.g. @[], _:_@ is a better warning than listing concrete --- lists not matched for, even though @_:_@ is *not* a concrete value. --- The assumption is that both wildcards in fact *are* inhabited, otherwise --- we wouldn't show it. --- * Similarly the newtype instantiation stuff. If we treated newtypes like --- regular constructors, we'd just say @T _@ instead of --- @T (U []), T (U (_:_))@ for a chain of newtypes @T = T U; U = U [Int]@. --- Maybe not even @T _@, but just @_@ when @T@ was not instantiated once. --- * It commits to *one* COMPLETE set. --- --- On the other hand, 'ensureAllInhabited' --- * Tracks down *one* concrete inhabitant, even if that means recursing --- possibly multiple times. E.g. for @[True]@, we have to instantiate @(:)@ --- and then @True@ and @[]@. --- * Does not consider the type-evidence from instanting different variables as a whole. I.e., it does *not* backtrack! Instead it instantiates GADT constructor in one variable and then has to re-reck all variables again because of the new type info. Better operate on a incrementally consistent nabla than having to do all this work on every instantiation. --- * Problem: Instantiation changes the domain of SharedDIdEnv. worklist-like approach needed! --- * Also the treatment of residual complete matches is a bit concerning... --- --- I'm beginning to think that Nabla should only care for term-level evidence and contradictions, not for the combinatorial problem that arises from considering the type constraints unleashed by instantitation of GADT constructors. --- Then we could have a 'Nablas' where the invariant holds that there always is at least one concrete inhabited Nabla. compared to not splitting this concrete Nabla off its parent nabla (which has negative info), we maintain two Nablas where before we only had to maintain one. But that's only a constant, not linear like in a completely exploded (structural) approach. --- generateInhabitants :: [Id] -> Int -> Nabla -> DsM [Nabla] +-- See Note [Why inhabitationTest doesn't call generateInhabitants] generateInhabitants _ 0 _ = pure [] generateInhabitants [] _ nabla = pure [nabla] generateInhabitants (x:xs) n nabla = do @@ -1651,157 +1666,27 @@ pickApplicableCompleteSets ty rcm = do 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 --- equivalent to @e'@) we encountered earlier, or a fresh identifier if --- there weren't any such constraints. -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 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: --- --- * For @let x = Just (42, 'z')@ we want to record the --- constraints @x ~ Just a, a ~ (b, c), b ~ 42, c ~ 'z'@. --- See 'data_con_app'. --- * For @let x = unpackCString# "tmp"@ we want to record the literal --- constraint @x ~ "tmp"@. --- * For @let x = I# 42@ we want the literal constraint @x ~ 42 at . Similar --- 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 :: 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') 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 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 - -- syntax). See Note [COMPLETE sets on data families] - -- core_expr x e | pprTrace "core_expr" (ppr x $$ ppr e) False = undefined - core_expr x (Cast e _co) = core_expr x e - core_expr x (Tick _t e) = core_expr x e - core_expr x e - | Just (pmLitAsStringLit -> Just s) <- coreExprAsPmLit e - , expr_ty `eqType` stringTy - -- See Note [Representation of Strings in TmState] - = case unpackFS s of - -- We need this special case to break a loop with coreExprAsPmLit - -- Otherwise we alternate endlessly between [] and "" - [] -> data_con_app x emptyInScopeSet nilDataCon [] - s' -> core_expr x (mkListExpr charTy (map mkCharExpr s')) - | Just lit <- coreExprAsPmLit e - = pm_lit x lit - | Just (in_scope, _empty_floats@[], dc, _arg_tys, args) - <- exprIsConApp_maybe in_scope_env e - = data_con_app x in_scope dc args - -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe x - -- We don't consider DataCons flexible variables - = 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! - = equate_with_similar_expr x e - where - expr_ty = exprType e - expr_in_scope = mkInScopeSet (exprFreeVars e) - in_scope_env = (expr_in_scope, const NoUnfolding) - -- It's inconvenient to get hold of a global in-scope set - -- here, but it'll only be needed if exprIsConApp_maybe ends - -- up substituting inside a forall or lambda (i.e. seldom) - -- so using exprFreeVars seems fine. See MR !1647. - - -- | The @e@ in @let x = e@ had no familiar form. But we can still see if - -- 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 Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) - -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\nabla -> addVarCt nabla x rep) - - bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id - bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - core_expr x e - pure x - - -- | Look at @let x = K taus theta es@ and generate the following - -- constraints (assuming universals were dropped from @taus@ before): - -- 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 - (ex_ty_args, val_args) = splitAtList dc_ex_tvs args - ex_tys = map exprToType ex_ty_args - vis_args = reverse $ take arty $ reverse val_args - 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. @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 -> addPhiCtsNoTest nabla (listToBag ty_cts) - -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ - arg_ids <- traverse bind_expr vis_args - -- 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 . - -- 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 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 () -modifyT f = StateT $ fmap ((,) ()) . f - -{- Note [Detecting pattern synonym applications in expressions] +{- Note [Why inhabitationTest doesn't call generateInhabitants] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At the moment we fail to detect pattern synonyms in scrutinees and RHS of -guards. This could be alleviated with considerable effort and complexity, but -the returns are meager. Consider: - - pattern P - pattern Q - case P 15 of - Q _ -> ... - P 15 -> - -Compared to the situation where P and Q are DataCons, the lack of generativity -means we could never flag Q as redundant. (also see Note [Undecidable Equality -for PmAltCons] in PmTypes.) On the other hand, if we fail to recognise the -pattern synonym, we flag the pattern match as inexhaustive. That wouldn't happen -if we had knowledge about the scrutinee, in which case the oracle basically -knows "If it's a P, then its field is 15". - -This is a pretty narrow use case and I don't think we should to try to fix it -until a user complains energetically. +Every now and then I forget why 'inhabitationTest' (IT) and +'generateInhabitants' (GI) can't share more code. Here are a few pain points I +found out about the hard way: + + * GI only considers match variables, so no let-bindings. Could probably be fixed. + * GI only explodes a pattern once, when there is no positive evidence. This + is for better warning messages; e.g. @[], _:_@ is a better warning than + listing concrete lists not matched for, even though @_:_@ is *not* a + concrete value. The assumption is that both wildcards in fact *are* + inhabited, otherwise we wouldn't show it. That implies that the + (recursive!) IT has pruned the nabla before. + * Similarly the newtype instantiation stuff. If GI treated newtypes like + regular constructors, we'd just say @T _@ instead of + @T (U []), T (U (_:_))@ for a chain of newtypes @T = T U; U = U [Int]@. + Maybe not even @T _@, but just @_@ when @T@ was not instantiated once. + * GI commits to *one* COMPLETE set, and goes through some hoops to find + the minimal one. This implies it has to look at *all* constructors in + the residual COMPLETE matches and see if they match. Completely + untractable for an efficient IT. + +Feel free to add more. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88b71323c0fc30e5882512932c2849fcdafa125f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88b71323c0fc30e5882512932c2849fcdafa125f You're receiving 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 16 16:31:36 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 16 Sep 2020 12:31:36 -0400 Subject: [Git][ghc/ghc][wip/T18126] 3 commits: Implement Quick Look impredicativity Message-ID: <5f623de81bb72_80b3f83f39eeb001247773f@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: da59b24e by Simon Peyton Jones at 2020-09-16T17:31:05+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 68577cea by Simon Peyton Jones at 2020-09-16T17:31:05+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 - - - - - 3f4fc77d by Ben Gamari at 2020-09-16T17:31:05+01:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 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/5b706077bc7b82a71c1c6d003a3946c08f517450...3f4fc77d4340ebf98e87e8906628f743b9bb25fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b706077bc7b82a71c1c6d003a3946c08f517450...3f4fc77d4340ebf98e87e8906628f743b9bb25fa You're receiving 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 16 16:37:38 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 12:37:38 -0400 Subject: [Git][ghc/ghc][wip/T18249] Don't delay inhabitation test Message-ID: <5f623f5217939_80b3f8486479bdc12483171@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: d032abb1 by Sebastian Graf at 2020-09-16T18:37:23+02:00 Don't delay inhabitation test - - - - - 1 changed file: - compiler/GHC/HsToCore/PmCheck/Oracle.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -613,18 +613,10 @@ initFuel = 4 -- 4 because it's the smallest number that passes f' in T17977b addPhiCts :: Nabla -> PhiCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. addPhiCts nabla cts = runMaybeT $ do - nabla' <- addPhiCtsNoTest nabla cts - -- See Note [Delaying the inhabitation test] - inhabitationTest initFuel (nabla_ty_st nabla) nabla' - --- | Add 'PmCts' ('addPhiCts') without performing an inhabitation test by --- instantiation afterwards. Very much for internal use only! -addPhiCtsNoTest :: Nabla -> PhiCts -> MaybeT DsM Nabla --- See Note [TmState invariants]. -addPhiCtsNoTest nabla cts = do let (ty_cts, tm_cts) = partitionPhiCts cts nabla' <- addTyCts nabla (listToBag ty_cts) - foldlM addPhiTmCt nabla' (listToBag tm_cts) + nabla'' <- foldlM addPhiTmCt nabla' (listToBag tm_cts) + inhabitationTest initFuel (nabla_ty_st nabla) nabla'' partitionPhiCts :: PhiCts -> ([PredType], [PhiCt]) partitionPhiCts = partitionEithers . map to_either . toList @@ -791,7 +783,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) - nabla' <- addPhiCtsNoTest nabla (listToBag ty_cts) + nabla' <- MaybeT $ addPhiCts nabla (listToBag ty_cts) let add_var_ct nabla (a, b) = addVarCt nabla a b foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args Nothing -> do @@ -964,7 +956,7 @@ addCoreCt nabla x e = do 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 -> addPhiCtsNoTest nabla (listToBag ty_cts) + modifyT $ \nabla -> MaybeT $ addPhiCts nabla (listToBag ty_cts) -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ arg_ids <- traverse bind_expr vis_args -- 4. @x ~ K as ys@ @@ -1527,13 +1519,6 @@ like Since the coverage won't bother to instantiate Down 4 levels deep to see that it is in fact uninhabited, it will emit a inexhaustivity warning for the case. -Note [Delaying the Inhabitation test] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We delay the inhabitation test that normally happens after having added -negative information or a type constraints. This has the potential to do -less inhabitation tests for φ constructor constraints, which potentially add a -bunch of ≁⊥ and type constraints at once. - Note [DataCons that are definitely inhabitable] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Another microoptimization applies to data types like this one: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d032abb1cfe11f4067397606269847a36c3711e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d032abb1cfe11f4067397606269847a36c3711e3 You're receiving 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 16 16:58:26 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 12:58:26 -0400 Subject: [Git][ghc/ghc][wip/T18249] 16 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f6244323f35_80b77a1f0012483415@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 290d96c4 by Sebastian Graf at 2020-09-16T18:38:44+02:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - 314ef1aa by Sebastian Graf at 2020-09-16T18:58:13+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as @{ x:[a] | x /= [] }@). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Docs.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/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Gen/Expr.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 - compiler/GHC/ThToHs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d032abb1cfe11f4067397606269847a36c3711e3...314ef1aa6acc7795b79aa760bf8d8ab745993ac3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d032abb1cfe11f4067397606269847a36c3711e3...314ef1aa6acc7795b79aa760bf8d8ab745993ac3 You're receiving 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 16 17:00:54 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 16 Sep 2020 13:00:54 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f6244c6ee5f_80b3f8474da257c124837b7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 31f57061 by Sebastian Graf at 2020-09-16T19:00:35+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as @{ x:[a] | x /= [] }@). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249. Metric Decrease: T17836 T17836b T17977 T18478 - - - - - 13 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitants 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +986,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1233,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitants vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1373,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1386,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -485,6 +486,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +508,6 @@ 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. @@ -522,6 +522,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +535,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,6 +579,24 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where ppr MaybeBot = empty ppr IsBot = text "~⊥" @@ -583,33 +604,45 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg = char '≁' <> ppr neg -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -1,9 +1,7 @@ module GHC.HsToCore.PmCheck.Types where -import GHC.Data.Bag - data Nabla -newtype Nablas = MkNablas (Bag Nabla) +data Nablas-- = MkNablas (Bag Nabla) initNablas :: Nablas ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,35 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + | +14 | f !_ | False = 1 + | ^^^^^ + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + | +25 | g !_ = 1 + | ^ + +T18249.hs:29:16: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + | +29 | h (# _, _ #) | False = 1 + | ^^^^^ + +T18249.hs:33:13: warning: [-Woverlapping-patterns] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + | +33 | i !_ | False = 1 + | ^^^^^ + +T18249.hs:34:13: warning: [-Woverlapping-patterns] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... + | +34 | i (I# !_) | False = 2 + | ^^^^^ ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31f57061098465b3fdb9c6d9246426c833b5c4a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31f57061098465b3fdb9c6d9246426c833b5c4a1 You're receiving 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 16 17:41:51 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Wed, 16 Sep 2020 13:41:51 -0400 Subject: [Git][ghc/ghc][wip/T18653] Fix printing of promoted unboxed tuples (#18653) Message-ID: <5f624e5fc1b28_80b850d64412498295@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18653 at Glasgow Haskell Compiler / GHC Commits: 02191891 by Krzysztof Gogolewski at 2020-09-16T19:41:37+02:00 Fix printing of promoted unboxed tuples (#18653) - - - - - 6 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Type.hs - + testsuite/tests/ghci/scripts/T18653.script - + testsuite/tests/ghci/scripts/T18653.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -1018,7 +1018,9 @@ mk_tuple Unboxed arity = (tycon, tuple_con) UnboxedTuple flavour -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon - -- Kind: forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> # + -- Example: the kind of (#,#) is + -- forall (k1::RuntimeRep) (k2::RuntimeRep). TYPE k1 -> TYPE k2 -> + -- TYPE (TupleRep '[k1, k2]) tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy) (\ks -> map tYPE ks) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -189,8 +189,8 @@ toIfaceTypeX fr (TyConApp tc tys) | Just dc <- isPromotedDataCon_maybe tc , isBoxedTupleDataCon dc - , n_tys == 2*arity - = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) + , n_tys == arity + = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc tys) | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ] , (k1:k2:_) <- tys ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1573,7 +1573,18 @@ pprTuple ctxt_prec sort promoted args = case promoted of IsPromoted -> let tys = appArgsIfaceTypes args - args' = drop (length tys `div` 2) tys + -- For promoted boxed tuples, drop half of the type arguments: + -- display '(,) @Type @(Type -> Type) Int Maybe + -- as '(Int, Maybe) + -- For promoted unboxed tuples, additionally drop RuntimeRep vars; + -- display '(#,#) @LiftedRep @LiftedRep @Type @(Type -> Type) Int Maybe + -- as '(# Int, Maybe #) + -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon + -- and ticket #18653 + toDrop = case sort of + UnboxedTuple -> 2 * length tys `div` 3 + _ -> length tys `div` 2 + args' = drop toDrop tys spaceIfPromoted = case args' of arg0:_ -> pprSpaceIfPromotedTyCon arg0 _ -> id ===================================== testsuite/tests/ghci/scripts/T18653.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(#,,,#) Int Char Bool Maybe +:kind! '(,,,) Int Char Bool Maybe ===================================== testsuite/tests/ghci/scripts/T18653.stdout ===================================== @@ -0,0 +1,4 @@ +'(#,,,#) Int Char Bool Maybe :: (# *, *, *, * -> * #) += '(# Int, Char, Bool, Maybe #) +'(,,,) Int Char Bool Maybe :: (*, *, *, * -> *) += '(Int, Char, Bool, Maybe) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -319,3 +319,4 @@ 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']) +test('T18653', normal, ghci_script, ['T18653.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02191891c080137a161c7861706db3dd484254d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02191891c080137a161c7861706db3dd484254d1 You're receiving 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 16 18:05:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Sep 2020 14:05:36 -0400 Subject: [Git][ghc/ghc][wip/initializers] rts: Refactor unloading of foreign export StablePtrs Message-ID: <5f6253f0ad854_80b1097b08412499046@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 40aaa8a2 by Ben Gamari at 2020-09-16T14:05:29-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. - - - - - 4 changed files: - includes/rts/ForeignExports.h - rts/ForeignExports.c - rts/Linker.c - rts/LinkerInternals.h Changes: ===================================== includes/rts/ForeignExports.h ===================================== @@ -29,6 +29,8 @@ struct ForeignExportsList { /* 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[]; }; ===================================== rts/ForeignExports.c ===================================== @@ -48,12 +48,14 @@ static ObjectCode *loading_obj = NULL; * 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`. + * `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. * */ @@ -94,20 +96,35 @@ void foreignExportsFinishedLoadingObject() void processForeignExports() { while (pending) { - for (int i=0; i < pending->n_entries; i++) { - StgPtr p = pending->exports[i]; - StgStablePtr *sptr = getStablePtr(p); + struct ForeignExportsList *cur = pending; + pending = cur->next; - 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; + /* 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->foreign_exports; + cur->oc->foreign_exports = 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]); } } - - pending = pending->next; } } ===================================== rts/Linker.c ===================================== @@ -1239,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; } static void @@ -1404,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif ===================================== 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 */ + struct ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40aaa8a26ec610bc652847c936fe0a511faeb0a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40aaa8a26ec610bc652847c936fe0a511faeb0a7 You're receiving 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 16 19:30:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Sep 2020 15:30:27 -0400 Subject: [Git][ghc/ghc][wip/initializers] 20 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f6267d3ab52d_80becac9081253623@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 9436cac0 by Ben Gamari at 2020-09-16T15:30:20-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. - - - - - 9c748240 by Ben Gamari at 2020-09-16T15:30:20-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. - - - - - 17 changed files: - .gitignore - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/Decl.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/40aaa8a26ec610bc652847c936fe0a511faeb0a7...9c748240149aa27af74ca721b2c1d144ed82a1a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40aaa8a26ec610bc652847c936fe0a511faeb0a7...9c748240149aa27af74ca721b2c1d144ed82a1a1 You're receiving 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 16 20:36:47 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 16 Sep 2020 16:36:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: docs: correct haddock reference Message-ID: <5f62775ff195a_80b83b0620125513d8@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - f2b18157 by Simon Peyton Jones at 2020-09-16T16:36:39-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 81385958 by Leif Metcalf at 2020-09-16T16:36:39-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - f101b540 by Richard Eisenberg at 2020-09-16T16:36:39-04:00 Document IfaceTupleTy - - - - - 9 changed files: - README.md - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Demand.hs - docs/users_guide/exts/assert.rst - + testsuite/tests/simplCore/should_run/T18638.hs - + testsuite/tests/simplCore/should_run/T18638.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== README.md ===================================== @@ -26,7 +26,7 @@ There are two ways to get a source tree: 2. *Check out the source code from git* - $ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git + $ git clone --recurse-submodules git at gitlab.haskell.org:ghc/ghc.git Note: cloning GHC from Github requires a special setup. See [Getting a GHC repository from Github][7]. ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -34,9 +34,10 @@ module GHC.Core.FVs ( bndrRuleAndUnfoldingVarsDSet, idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, - ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, + ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, + ruleRhsFreeVars, ruleRhsFreeIds, expr_fvs, @@ -524,6 +525,14 @@ ruleLhsFVIds (BuiltinRule {}) = emptyFV ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) +ruleRhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) + = fvVarSet $ filterFV isLocalId $ + addBndrs bndrs $ exprs_fvs args + {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.Seq ( seqBinds ) import GHC.Utils.Outputable import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Basic import Data.List ( mapAccumL ) import GHC.Core.DataCon @@ -32,6 +33,7 @@ import GHC.Types.Id.Info import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type +import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import GHC.Utils.Misc @@ -552,7 +554,9 @@ 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 + DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty + sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) -- See Note [Aggregated demand for cardinality] @@ -560,10 +564,23 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs Just bs -> reuseEnv (delVarEnvList rhs_fv bs) Nothing -> rhs_fv + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs + -- See Note [Lazy and unleashable free variables] - (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv1 + (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv2 is_thunk = not (exprIsHNF rhs) && not (isJoinId id) + -- Find the RHS free vars of the unfoldings and RULES + -- See Note [Absence analysis for stable unfoldings and RULES] + extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ + idCoreRules id + + unf = realIdUnfolding id + unf_fvs | isStableUnfolding unf + , Just unf_body <- maybeUnfoldingTemplate unf + = exprFreeIds unf_body + | otherwise = emptyVarSet + -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for -- unleashing on the given function's @rhs@, by creating -- a call demand of @rhs_arity@ @@ -799,6 +816,43 @@ 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 and RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +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, adjust its DmdEnv (the demands +on its free variables) so that no variable mentioned in its unfolding +is Absent. This is done by the function Demand.keepAliveDmdEnv. + +ALSO: do the same for Ids free in the RHS of any RULES for f. + +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 + {-# INLINE 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/Iface/Type.hs ===================================== @@ -176,6 +176,11 @@ data IfaceType PromotionFlag -- A bit like IfaceTyCon IfaceAppArgs -- arity = length args -- For promoted data cons, the kind args are omitted + -- Why have this? Only for efficiency: IfaceTupleTy can omit the + -- type arguments, as they can be recreated when deserializing. + -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression + -- in interface file size (in GHC's boot libraries). + -- See !3987. type IfaceMult = IfaceType ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Types.Demand ( BothDmdArg, mkBothDmdArg, toBothDmdArg, nopDmdType, botDmdType, addDemand, - DmdEnv, emptyDmdEnv, + DmdEnv, emptyDmdEnv, keepAliveDmdEnv, peelFV, findIdDemand, Divergence(..), lubDivergence, isDeadEndDiv, @@ -59,8 +59,9 @@ module GHC.Types.Demand ( import GHC.Prelude -import GHC.Types.Var ( Var ) +import GHC.Types.Var ( Var, Id ) import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Data.Maybe ( orElse ) @@ -809,10 +810,22 @@ splitFVs is_thunk rhs_fvs :*: addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs }) -data StrictPair a b = !a :*: !b +keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv +-- (keepAliveDmdType dt vs) makes sure that the Ids in vs have +-- /some/ usage in the returned demand types -- they are not Absent +-- See Note [Absence analysis for stable unfoldings and RULES] +-- in GHC.Core.Opt.DmdAnal +keepAliveDmdEnv env vs + = nonDetStrictFoldVarSet add env vs + where + add :: Id -> DmdEnv -> DmdEnv + add v env = extendVarEnv_C add_dmd env v topDmd -strictPairToTuple :: StrictPair a b -> (a, b) -strictPairToTuple (x :*: y) = (x, y) + add_dmd :: Demand -> Demand -> Demand + -- If the existing usage is Absent, make it used + -- Otherwise leave it alone + add_dmd dmd _ | isAbsDmd dmd = topDmd + | otherwise = dmd splitProdDmd_maybe :: Demand -> Maybe [Demand] -- Split a product into its components, iff there is any @@ -827,6 +840,11 @@ splitProdDmd_maybe (JD { sd = s, ud = u }) (Lazy, Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux) _ -> Nothing +data StrictPair a b = !a :*: !b + +strictPairToTuple :: StrictPair a b -> (a, b) +strictPairToTuple (x :*: y) = (x, y) + {- ********************************************************************* * * TypeShape and demand trimming @@ -1541,9 +1559,9 @@ There are several wrinkles: can be evaluated in a short finite time -- and that rules out nasty cases like the one above. (I'm not quite sure why this was a problem in an earlier version of GHC, but it isn't now.) +-} - -************************************************************************ +{- ********************************************************************* * * Demand signatures * * ===================================== docs/users_guide/exts/assert.rst ===================================== @@ -33,7 +33,7 @@ assertion was made, :: assert pred val ==> assertError "Main.hs|15" pred val The rewrite is only performed by the compiler when it spots applications -of ``Control.Exception.assert``, so you can still define and use your +of :base-ref:`Control.Exception.assert`, so you can still define and use your own versions of ``assert``, should you so wish. If not, import ``Control.Exception`` to make use ``assert`` in your code. @@ -48,6 +48,6 @@ will be rewritten to ``e``. You can also disable assertions using the allows enabling assertions even when optimisation is turned on. Assertion failures can be caught, see the documentation for the -:base-ref:`Control.Exception` library for the details. +:base-ref:`Control.Exception.` library for the details. ===================================== 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6dda93bdf791cc19298a2c35b8bdb040394c8a7...f101b540c6edd462f508f91bc5f888f63fde7140 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6dda93bdf791cc19298a2c35b8bdb040394c8a7...f101b540c6edd462f508f91bc5f888f63fde7140 You're receiving 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 16 22:10:26 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Wed, 16 Sep 2020 18:10:26 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] 2 commits: Rewrite matchHasField to generate evidence more directly Message-ID: <5f628d52b61ba_80b3f849065727412557389@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: 2c5a8f22 by Adam Gundry at 2020-09-16T22:39:40+01:00 Rewrite matchHasField to generate evidence more directly - - - - - a03af150 by Adam Gundry at 2020-09-16T23:08:51+01:00 Notes and Queries - - - - - 3 changed files: - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/FieldLabel.hs Changes: ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -44,7 +44,7 @@ import GHC.Core.Class import GHC.Driver.Session import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Utils.Misc( splitAtList, fstOf3 ) +import GHC.Utils.Misc( splitAtList, fstOf3, debugIsOn ) import Data.Maybe {- ******************************************************************* @@ -606,6 +606,7 @@ matchCoercible args = pprPanic "matchLiftedCoercible" (ppr args) {- Note [HasField instances] ~~~~~~~~~~~~~~~~~~~~~~~~~ + Suppose we have data T y = MkT { foo :: [y] } @@ -619,44 +620,56 @@ We want GHC to automatically solve a constraint like HasField "foo" (T Int) b -by emitting a new wanted - - (T alpha -> ([alpha] -> T alpha, [alpha])) ~# (T Int -> (b -> T Int, b)) +by building a HasField dictionary out of the updater function `$upd:foo:MKT`. +(See Note [Record updaters] in GHC.Tc.TyCl.Utils for how updaters are built.) -and building a HasField dictionary out of the updater function `$upd:foo:MKT`. -See Note [Record updaters] in GHC.Tc.TyCl.Utils for how updaters are built. +If `foo` is not in scope, or has a higher-rank or existentially +quantified type, then the constraint is not solved automatically, but +may be solved by a user-supplied HasField instance. Similarly, if we +encounter a HasField constraint where the field is not a literal +string, or does not belong to the type, then we fall back on the +normal constraint solver behaviour. -Since HasField is a one-method class, it is represented as a newtype. -Hence we can solve `HasField "foo" (T Int) b` by taking an expression -of type `T Int -> (b -> T Int, b)` and casting it using the newtype coercion. Note that $upd:foo:MKT :: forall y . T y -> ([y] -> T y, [y]) -so the expression we construct is +so we instantiate the updater's type with fresh metavariable(s) (here just one, +namely alpha), emit new wanteds: + + [W] data_co :: T alpha ~# T Int + [W] fld_co :: [alpha] ~# b + +and construct the dictionary - $upd:foo:MKT @alpha |> co + ev :: HasField "foo" (T Int) b + ev = $upd:foo:MKT @alpha |> co where co :: (T alpha -> ([alpha] -> T alpha, [alpha])) ~# HasField "foo" (T Int) b + co = sym nt_co ; hf_co -is built from + -- From the instantiated newtype coercion, since HasField is a single-method type class + nt_co :: HasField "foo" (T alpha) [alpha] ~# (T alpha -> ([alpha] -> T alpha, [alpha])) - co1 :: (T alpha -> ([alpha] -> T alpha, [alpha])) ~# (T Int -> (b -> T Int, b)) + hf_co :: HasField "foo" (T alpha) [alpha] ~# HasField "foo" (T Int) b + hf_co = HasField <"foo"> data_co fld_co -which is the new wanted, and - co2 :: (T Int -> (b -> T Int, b)) ~# HasField "foo" (T Int) b +Looking at the wanted T alpha ~# T Int, you might think that we could avoid +instantiating the updater's type with fresh metavariables, and instead construct +a substitution [Int/alpha] directly. However this would not work for GADTs, for +example: -which can be derived from the newtype coercion. + data S a where + MkS :: { foo :: Either p q } -> S (p,q) -If `foo` is not in scope, or has a higher-rank or existentially -quantified type, then the constraint is not solved automatically, but -may be solved by a user-supplied HasField instance. Similarly, if we -encounter a HasField constraint where the field is not a literal -string, or does not belong to the type, then we fall back on the -normal constraint solver behaviour. +where the updater's type is + + $upd:foo:MkS :: forall p q. S (p,q) -> (Either p q -> S (p,q), Either p q) + +with no direct connection to the parameters of S itself. -} -- See Note [HasField instances] @@ -666,50 +679,81 @@ matchHasField dflags short_cut clas tys ; rdr_env <- getGlobalRdrEnv ; case tys of -- We are matching HasField {k} x r a... - [_k_ty, x_ty, r_ty, a_ty] - -- x should be a literal string - | Just x <- isStrLitTy x_ty + [k, x, r, a] + -- x should be a literal string (this implies k is Symbol) + | Just x_lit <- isStrLitTy x -- r should be an applied type constructor - , Just (tc, args) <- tcSplitTyConApp_maybe r_ty + , Just (tc, args) <- tcSplitTyConApp_maybe r -- use representation tycon (if data family); it has the fields , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args) -- x should be a field of r - , Just fl <- lookupTyConFieldLabel x r_tc + , Just fl <- lookupTyConFieldLabel x_lit r_tc -- the field selector should be in scope , Just gre <- lookupGRE_FieldLabel rdr_env fl - -> do { upd_id <- tcLookupId (flUpdate fl) - ; (tv_prs, preds, upd_ty) <- tcInstType newMetaTyVars upd_id - - -- The first new wanted constraint equates the actual - -- type of the updater with the type (r -> (a -> r, a)) - -- within the HasField x r a dictionary. The preds - -- will typically be empty, but if the datatype has a - -- "stupid theta" then we have to include it here. - ; let theta = mkPrimEqPred upd_ty (mkVisFunTyMany r_ty (mkBoxedTupleTy [mkVisFunTyMany a_ty r_ty, a_ty])) : preds - - -- Use the equality proof to cast the updater Id to - -- type (r -> (a -> r, a)), then use the newtype - -- coercion to cast it to a HasField dictionary. - mk_ev (ev1:evs) = evSelector upd_id tvs evs `evCast` co - where - co = mkTcSubCo (evTermCoercion (EvExpr ev1)) - `mkTcTransCo` mkTcSymCo co2 - mk_ev [] = panic "matchHasField.mk_ev" - - Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas) - tys - - tvs = mkTyVarTys (map snd tv_prs) - + -> ASSERT ( k `eqType` typeSymbolKind ) + -- Look up the updater and instantiate its type with fresh metavars + do { upd_id <- tcLookupId (flUpdate fl) + ; inst_upd@(_, _, upd_ty) <- tcInstType newMetaTyVars upd_id -- Do not generate an instance if the updater cannot be -- defined for the field and hence is (). (See Note -- [Naughty record updaters] in GHC.Tc.TyCl.Utils.) ; if not (upd_ty `eqType` unitTy) then do { addUsedGRE True gre - ; return OneInst { cir_new_theta = theta - , cir_mk_ev = mk_ev - , cir_what = BuiltinInstance } } + ; return $ mkHasFieldEvidence clas (x, r, a) + upd_id inst_upd } else matchInstEnv dflags short_cut clas tys } _ -> matchInstEnv dflags short_cut clas tys } + +-- | Build the dictionary for a @HasField x r a@ constraint using its updater. +-- See Note [HasField instances]. +mkHasFieldEvidence + :: Class -- ^ HasField class + -> (Type, Type, Type) -- ^ (x, r, a) type parameters of HasField constraint + -> Id -- ^ Updater Id $upd:x:... + -> ([(Name, TcTyVar)], TcThetaType, TcType) + -- ^ (tyvars, preds, rho) from instantiating the updater's type + -> ClsInstResult +mkHasFieldEvidence clas (x, r, a) upd_id (tv_prs, preds, upd_ty) = + OneInst { cir_new_theta = theta + , cir_mk_ev = mk_ev + , cir_what = BuiltinInstance } + where + -- Updater types satisfy by construction + -- upd_ty = (data_ty -> (fld_ty -> data_ty, fld_ty)) + -- where data_ty is the datatype and fld_ty is the field type. + (_, data_ty, setter_field_pair) = splitFunTy upd_ty + (_, [_, fld_ty]) = splitTyConApp setter_field_pair + + -- Emit new wanteds in order to convert `HasField x data_ty fld_ty` (built + -- from the updater) into `HasField x r a` (the constraint we are solving). + -- The preds will typically be empty, but if the datatype has a "stupid + -- theta" it will be included here, as the updater quantifies over it. + theta = mkPrimEqPred data_ty r -- data_co :: data_ty ~# r + : mkPrimEqPred fld_ty a -- fld_co :: fld_ty ~# a + : preds + + -- Instantiate the updater Id appropriately, use the newtype coercion to + -- cast it to a `HasField x data_ty fld_ty` dictionary, then use the + -- equality witnesses to convert it to a `HasField x r a` dictionary. + mk_ev (data_co:fld_co:evs) = + evSelector upd_id (mkTyVarTys (map snd tv_prs)) evs + `evCast` (mkTcSymCo nt_co `mkTcTransCo` hf_co data_co fld_co) + mk_ev evs = pprPanic "mkHasFieldEvidence.mk_ev" (ppr evs) + + -- hf_co :: HasField x data_ty fld_ty ~# HasField x r a + -- hf_co = HasField data_co fld_co + hf_co data_co fld_co = mkTcTyConAppCo Representational hasFieldTyCon + [ mkTcNomReflCo typeSymbolKind + , mkTcNomReflCo x + , evTermCoercion (EvExpr data_co) + , evTermCoercion (EvExpr fld_co) + ] + + -- nt_co :: HasField x data_ty fld_ty ~# (data_ty -> (fld_ty -> data_ty, fld_ty)) + nt_co = maybe (panic "mkHasFieldEvidence:nt_co") snd $ + tcInstNewTyCon_maybe hasFieldTyCon + [typeSymbolKind, x, data_ty, fld_ty] + + hasFieldTyCon = classTyCon clas ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -1183,6 +1183,14 @@ type (e.g. 'b' in T2). Note the need for casts in the result! +All this applies to updaters (see Note [Record updaters]) as well as selectors; +in the example above we will build this updater: + $upd:f:T1 :: T [a] -> (Maybe a -> T [a], Maybe a) + +If a GADT field has bona-fide existential tyvars that do not appear in the +result type, the selector will be naughty (see Note [Naughty record selectors]). + + Note [Selector running example] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's OK to combine GADTs and type families. Here's a running example: @@ -1268,7 +1276,7 @@ Note that: scope. * The Name of each updater is stored alongside that of the selector in the - 'FieldLabel's in each 'DataCon'. + 'FieldLabel's in each 'DataCon'. See the notes in GHC.Types.FieldLabel. * Renamed-syntax bindings for both a selector and an updater for each field are produced by mkRecordSelectorAndUpdater; these bindings are then type-checked @@ -1285,6 +1293,16 @@ Note that: name to () instead, even if we can generate the corresponding selector. See Note [Naughty record updaters]. + * We could imagine generating the selector *from* the updater, i.e. build + $sel:foo:T r = case $upd:foo:T r of (_, x) -> x + but we don't do so because the updater might be naughty, and for pattern + synonyms will not exist at all (see Note [No updaters for pattern synonyms]). + + * For GADTs, we insist that all constructors mentioning a field have the same + type, and reject the definition entirely if not. Thus if the field does not + involve an existential (and hence is not naughty) we can make both a selector + and an updater (see Note [GADT record selectors]). + Note [Naughty record updaters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1332,7 +1350,9 @@ do this at HasField constraint solving time instead, at least for updaters? Note [No updaters for pattern synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For record pattern synonyms, we generate a selector function, but not an -updater. The updater function is not necessary because we do not solve HasField +updater. In principle it would be possible to build an updater for +bidirectional pattern synonyms, but not for unidirectional ones. In any case, +the updater function is not necessary because we do not solve HasField constraints for fields defined by pattern synonyms. That is, given @@ -1355,10 +1375,11 @@ which will be subject to the usual rules around orphan instances and the restrictions on when HasField instances can be defined (as described in Note [Validity checking of HasField instances] in GHC.Tc.Validity). -We could imagine allowing record pattern synonyms to lead to automatic HasField -constraint solving, but this potentially introduces incoherent HasField -instances, because multiple pattern synonyms (in different modules) might use -the same field name in the same type, and would even lead to e.g. +We could imagine allowing (bidirectional) record pattern synonyms to lead to +automatic HasField constraint solving, but this potentially introduces +incoherent HasField instances, because multiple pattern synonyms (in different +modules) might use the same field name in the same type, and would even lead to +e.g. pattern Id{id} = id ===================================== compiler/GHC/Types/FieldLabel.hs ===================================== @@ -40,6 +40,11 @@ Now there will be two FieldLabel values for 'foo', one in T and one in U. They share the same label (FieldLabelString), but the selector functions differ. +There is no Deep and Subtle Reason why we couldn't use mangled $sel: names for +all selectors, not just those defined when DuplicateRecordFields is enabled. +However, this exposes various bugs in the DuplicateRecordFields implementation, +so we have not yet made this simplification. + See also Note [Representing fields in AvailInfo] in GHC.Types.Avail. Note [Why selector names include data constructors] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdff0fe1834729148842ac0d7b94e68a9c916466...a03af1504b3cb178a070f58a2afefa681ad37f07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdff0fe1834729148842ac0d7b94e68a9c916466...a03af1504b3cb178a070f58a2afefa681ad37f07 You're receiving 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 17 02:02:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 16 Sep 2020 22:02:10 -0400 Subject: [Git][ghc/ghc][ghc-9.0] Export enrichHie from GHC.Iface.Ext.Ast Message-ID: <5f62c3a23576c_80b112998501258647e@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 12d9742c by Zubin Duggal at 2020-09-16T14:38:15-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` Backport of !4037 - - - - - 1 changed file: - compiler/GHC/Iface/Ext/Ast.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d9742c523ab3b69db9c98e4a113f7ed8bdf754 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d9742c523ab3b69db9c98e4a113f7ed8bdf754 You're receiving 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 17 05:26:53 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 01:26:53 -0400 Subject: [Git][ghc/ghc][master] docs: correct haddock reference Message-ID: <5f62f39da5ce1_80b3f849640b9b0125905d2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 1 changed file: - docs/users_guide/exts/assert.rst Changes: ===================================== docs/users_guide/exts/assert.rst ===================================== @@ -33,7 +33,7 @@ assertion was made, :: assert pred val ==> assertError "Main.hs|15" pred val The rewrite is only performed by the compiler when it spots applications -of ``Control.Exception.assert``, so you can still define and use your +of :base-ref:`Control.Exception.assert`, so you can still define and use your own versions of ``assert``, should you so wish. If not, import ``Control.Exception`` to make use ``assert`` in your code. @@ -48,6 +48,6 @@ will be rewritten to ``e``. You can also disable assertions using the allows enabling assertions even when optimisation is turned on. Assertion failures can be caught, see the documentation for the -:base-ref:`Control.Exception` library for the details. +:base-ref:`Control.Exception.` library for the details. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6baa67f5500da6ca74272016ec8fd62a4b5b5050 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6baa67f5500da6ca74272016ec8fd62a4b5b5050 You're receiving 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 17 05:27:33 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 01:27:33 -0400 Subject: [Git][ghc/ghc][master] Do absence analysis on stable unfoldings Message-ID: <5f62f3c54553_80b78b99ec125946af@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 6 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Types/Demand.hs - + testsuite/tests/simplCore/should_run/T18638.hs - + testsuite/tests/simplCore/should_run/T18638.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -34,9 +34,10 @@ module GHC.Core.FVs ( bndrRuleAndUnfoldingVarsDSet, idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, - ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, + ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, mkRuleInfo, ruleLhsFreeIds, ruleLhsFreeIdsList, + ruleRhsFreeVars, ruleRhsFreeIds, expr_fvs, @@ -524,6 +525,14 @@ ruleLhsFVIds (BuiltinRule {}) = emptyFV ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) +ruleRhsFreeIds :: CoreRule -> VarSet +-- ^ This finds all locally-defined free Ids on the left hand side of a rule +-- and returns them as a non-deterministic set +ruleRhsFreeIds (BuiltinRule {}) = emptyVarSet +ruleRhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args }) + = fvVarSet $ filterFV isLocalId $ + addBndrs bndrs $ exprs_fvs args + {- Note [Rule free var hack] (Not a hack any more) ~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -23,6 +23,7 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.Seq ( seqBinds ) import GHC.Utils.Outputable import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Basic import Data.List ( mapAccumL ) import GHC.Core.DataCon @@ -32,6 +33,7 @@ import GHC.Types.Id.Info import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type +import GHC.Core.FVs ( exprFreeIds, ruleRhsFreeIds ) import GHC.Core.Coercion ( Coercion, coVarsOfCo ) import GHC.Core.FamInstEnv import GHC.Utils.Misc @@ -552,7 +554,9 @@ 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 + DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty + sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) -- See Note [Aggregated demand for cardinality] @@ -560,10 +564,23 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs Just bs -> reuseEnv (delVarEnvList rhs_fv bs) Nothing -> rhs_fv + rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs + -- See Note [Lazy and unleashable free variables] - (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv1 + (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv2 is_thunk = not (exprIsHNF rhs) && not (isJoinId id) + -- Find the RHS free vars of the unfoldings and RULES + -- See Note [Absence analysis for stable unfoldings and RULES] + extra_fvs = foldr (unionVarSet . ruleRhsFreeIds) unf_fvs $ + idCoreRules id + + unf = realIdUnfolding id + unf_fvs | isStableUnfolding unf + , Just unf_body <- maybeUnfoldingTemplate unf + = exprFreeIds unf_body + | otherwise = emptyVarSet + -- | @mkRhsDmd env rhs_arity rhs@ creates a 'CleanDemand' for -- unleashing on the given function's @rhs@, by creating -- a call demand of @rhs_arity@ @@ -799,6 +816,43 @@ 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 and RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +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, adjust its DmdEnv (the demands +on its free variables) so that no variable mentioned in its unfolding +is Absent. This is done by the function Demand.keepAliveDmdEnv. + +ALSO: do the same for Ids free in the RHS of any RULES for f. + +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 + {-# INLINE 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/Types/Demand.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Types.Demand ( BothDmdArg, mkBothDmdArg, toBothDmdArg, nopDmdType, botDmdType, addDemand, - DmdEnv, emptyDmdEnv, + DmdEnv, emptyDmdEnv, keepAliveDmdEnv, peelFV, findIdDemand, Divergence(..), lubDivergence, isDeadEndDiv, @@ -59,8 +59,9 @@ module GHC.Types.Demand ( import GHC.Prelude -import GHC.Types.Var ( Var ) +import GHC.Types.Var ( Var, Id ) import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Data.Maybe ( orElse ) @@ -809,10 +810,22 @@ splitFVs is_thunk rhs_fvs :*: addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs }) -data StrictPair a b = !a :*: !b +keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv +-- (keepAliveDmdType dt vs) makes sure that the Ids in vs have +-- /some/ usage in the returned demand types -- they are not Absent +-- See Note [Absence analysis for stable unfoldings and RULES] +-- in GHC.Core.Opt.DmdAnal +keepAliveDmdEnv env vs + = nonDetStrictFoldVarSet add env vs + where + add :: Id -> DmdEnv -> DmdEnv + add v env = extendVarEnv_C add_dmd env v topDmd -strictPairToTuple :: StrictPair a b -> (a, b) -strictPairToTuple (x :*: y) = (x, y) + add_dmd :: Demand -> Demand -> Demand + -- If the existing usage is Absent, make it used + -- Otherwise leave it alone + add_dmd dmd _ | isAbsDmd dmd = topDmd + | otherwise = dmd splitProdDmd_maybe :: Demand -> Maybe [Demand] -- Split a product into its components, iff there is any @@ -827,6 +840,11 @@ splitProdDmd_maybe (JD { sd = s, ud = u }) (Lazy, Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux) _ -> Nothing +data StrictPair a b = !a :*: !b + +strictPairToTuple :: StrictPair a b -> (a, b) +strictPairToTuple (x :*: y) = (x, y) + {- ********************************************************************* * * TypeShape and demand trimming @@ -1541,9 +1559,9 @@ There are several wrinkles: can be evaluated in a short finite time -- and that rules out nasty cases like the one above. (I'm not quite sure why this was a problem in an earlier version of GHC, but it isn't now.) +-} - -************************************************************************ +{- ********************************************************************* * * Demand signatures * * ===================================== 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, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cf09ab013778227caa07b5d7ec9acd5dedd1817 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cf09ab013778227caa07b5d7ec9acd5dedd1817 You're receiving 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 17 05:28:07 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 01:28:07 -0400 Subject: [Git][ghc/ghc][master] Replace deprecated git --recursive Message-ID: <5f62f3e7133c7_80bd336cbc12595148@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - 1 changed file: - README.md Changes: ===================================== README.md ===================================== @@ -26,7 +26,7 @@ There are two ways to get a source tree: 2. *Check out the source code from git* - $ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git + $ git clone --recurse-submodules git at gitlab.haskell.org:ghc/ghc.git Note: cloning GHC from Github requires a special setup. See [Getting a GHC repository from Github][7]. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76d3bcbcef61ac71677855d6f90754ef019b9b4f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76d3bcbcef61ac71677855d6f90754ef019b9b4f You're receiving 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 17 05:28:45 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 01:28:45 -0400 Subject: [Git][ghc/ghc][master] Document IfaceTupleTy Message-ID: <5f62f40d8b309_80b78b99ec1259817e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 1 changed file: - compiler/GHC/Iface/Type.hs Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -176,6 +176,11 @@ data IfaceType PromotionFlag -- A bit like IfaceTyCon IfaceAppArgs -- arity = length args -- For promoted data cons, the kind args are omitted + -- Why have this? Only for efficiency: IfaceTupleTy can omit the + -- type arguments, as they can be recreated when deserializing. + -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression + -- in interface file size (in GHC's boot libraries). + -- See !3987. type IfaceMult = IfaceType View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da8f4ddd76bac18c721aeaa247725953604206d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da8f4ddd76bac18c721aeaa247725953604206d3 You're receiving 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 17 05:59:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 01:59:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Do absence analysis on stable unfoldings Message-ID: <5f62fb526d892_80b10e707c412604983@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - e5b378cd by HaskellMouse at 2020-09-17T01:59:32-04:00 Added explicit fixity to (~). Solves #18252 - - - - - 8181777e by Cary Robbins at 2020-09-17T01:59:35-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 5f4208db by Ben Gamari at 2020-09-17T01:59:36-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 5f4c5530 by Ben Gamari at 2020-09-17T01:59:36-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 3ccdc45b by Ben Gamari at 2020-09-17T01:59:36-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - b17d2cb9 by Leif Metcalf at 2020-09-17T01:59:36-04:00 Make Z-encoding comment into a note - - - - - 980dba09 by Leif Metcalf at 2020-09-17T01:59:36-04:00 Cosmetic - - - - - 29fcb9db by Vladislav Zavialov at 2020-09-17T01:59:37-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - ffa2045c by Benjamin Maurer at 2020-09-17T01:59:38-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - 30 changed files: - README.md - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Types/Demand.hs - compiler/GHC/Utils/Encoding.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/using.rst - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/base/Data/String.hs - libraries/directory - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - libraries/haskeline - rts/win32/IOManager.c - rts/win32/WorkQueue.c - testsuite/tests/ghci/T18060/T18060.stdout - testsuite/tests/ghci/scripts/T10059.stdout - + testsuite/tests/simplCore/should_run/T18638.hs - + testsuite/tests/simplCore/should_run/T18638.stdout - testsuite/tests/simplCore/should_run/all.T - + testsuite/tests/typecheck/should_compile/T18252.hs - + testsuite/tests/typecheck/should_fail/T18252a.hs - + testsuite/tests/typecheck/should_fail/T18252a.stderr - utils/check-api-annotations/check-api-annotations.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f101b540c6edd462f508f91bc5f888f63fde7140...ffa2045c5b08014dab04ccbdd94dd82aecfd0552 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f101b540c6edd462f508f91bc5f888f63fde7140...ffa2045c5b08014dab04ccbdd94dd82aecfd0552 You're receiving 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 17 08:22:01 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 17 Sep 2020 04:22:01 -0400 Subject: [Git][ghc/ghc][wip/T18126] 3 commits: Implement Quick Look impredicativity Message-ID: <5f631ca9349c5_80b3f849626462012625692@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 3c40898d by Simon Peyton Jones at 2020-09-17T09:21:38+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 552b267b by Simon Peyton Jones at 2020-09-17T09:21:38+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 - - - - - a0d5573a by Ben Gamari at 2020-09-17T09:21:38+01:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 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/3f4fc77d4340ebf98e87e8906628f743b9bb25fa...a0d5573a342896f52ef859fb5c655165b09b5242 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f4fc77d4340ebf98e87e8906628f743b9bb25fa...a0d5573a342896f52ef859fb5c655165b09b5242 You're receiving 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 17 08:57:43 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Sep 2020 04:57:43 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f63250771a7e_80b114d72e81263004f@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: f1abbd98 by Sebastian Graf at 2020-09-17T10:57:22+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as @{ x:[a] | x /= [] }@). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249. Metric Decrease: T17836 T17836b - - - - - 13 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitants 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +986,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1233,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitants vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1373,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1386,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -485,6 +486,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +508,6 @@ 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. @@ -522,6 +522,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +535,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,6 +579,24 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where ppr MaybeBot = empty ppr IsBot = text "~⊥" @@ -583,33 +604,45 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg = char '≁' <> ppr neg -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -1,9 +1,7 @@ module GHC.HsToCore.PmCheck.Types where -import GHC.Data.Bag - data Nabla -newtype Nablas = MkNablas (Bag Nabla) +data Nablas-- = MkNablas (Bag Nabla) initNablas :: Nablas ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1abbd98e5bc41f51e9fab748adbae4608f06ba3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1abbd98e5bc41f51e9fab748adbae4608f06ba3 You're receiving 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 17 10:50:48 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Sep 2020 06:50:48 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f633f8872426_80b10f4553c126428aa@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 7d299967 by Sebastian Graf at 2020-09-17T12:50:39+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as @{ x:[a] | x /= [] }@). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249. Metric Decrease: T17836 T17836b - - - - - 13 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitants 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +986,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1233,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitants vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1373,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1386,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,6 +582,24 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where ppr MaybeBot = empty ppr IsBot = text "~⊥" @@ -583,33 +607,45 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg = char '≁' <> ppr neg -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -1,9 +1,7 @@ module GHC.HsToCore.PmCheck.Types where -import GHC.Data.Bag - data Nabla -newtype Nablas = MkNablas (Bag Nabla) +data Nablas-- = MkNablas (Bag Nabla) initNablas :: Nablas ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d29996722c3de9110c5d3a4f620d4a94464ef2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d29996722c3de9110c5d3a4f620d4a94464ef2c You're receiving 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 17 11:59:25 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 17 Sep 2020 07:59:25 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f634f9de6f69_80b115ae0401265258d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: f6651efb by Sebastian Graf at 2020-09-17T13:59:15+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as @{ x:[a] | x /= [] }@). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249. Metric Decrease: T17836 T17836b - - - - - 14 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitants 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + tracePm "checkGrd:Con1" (ppr inc $$ ppr div) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "checkGrd:Con2" (ppr inc $$ ppr grd $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +986,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1233,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitants vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1373,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1386,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,6 +582,24 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where ppr MaybeBot = empty ppr IsBot = text "~⊥" @@ -583,33 +607,45 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, ppr cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg = char '≁' <> ppr neg -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6651efb8e4def29aa0b8776350cb4993de55c39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6651efb8e4def29aa0b8776350cb4993de55c39 You're receiving 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 17 12:11:59 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 17 Sep 2020 08:11:59 -0400 Subject: [Git][ghc/ghc][wip/andreask/allocationArea] 422 commits: Use dumpStyle when printing inlinings Message-ID: <5f63528f81c47_80b10abc5c412654881@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/allocationArea at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 289c151f by Andreas Klebinger at 2020-09-17T14:09:12+02:00 Increase -A default to 4MB. This gives a small increase in performance under most circumstances. For single threaded GC the improvement is on the order of 1-2%. For multi threaded GC the results are quite noisy but seem to fall into the same ballpark. Fixes #16499 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - CODEOWNERS - Makefile - README.md - 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 - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5275f44a45317d9806fb28ff94bc0b7d9aa99d1...289c151f405f39358030e1f4b1f757fb157c059f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5275f44a45317d9806fb28ff94bc0b7d9aa99d1...289c151f405f39358030e1f4b1f757fb157c059f You're receiving 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 17 12:49:59 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:49:59 -0400 Subject: [Git][ghc/ghc][master] Added explicit fixity to (~). Message-ID: <5f635b7710da4_80b3f84696094d81266192f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - 7 changed files: - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - testsuite/tests/ghci/T18060/T18060.stdout - testsuite/tests/ghci/scripts/T10059.stdout - + testsuite/tests/typecheck/should_compile/T18252.hs - + testsuite/tests/typecheck/should_fail/T18252a.hs - + testsuite/tests/typecheck/should_fail/T18252a.stderr Changes: ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -256,13 +256,20 @@ inside GHC, to change the kind and type. -- about the difference between heterogeneous equality @~~@ and -- homogeneous equality @~@, this is printed as @~@ unless -- @-fprint-equality-relations@ is set. +-- +-- In @0.7.0@, the fixity was set to @infix 4@ to match the fixity of 'Data.Type.Equality.:~~:'. class a ~~ b + -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -- | Lifted, homogeneous equality. By lifted, we mean that it -- can be bogus (deferred type error). By homogeneous, the two -- types @a@ and @b@ must have the same kinds. + +-- In @0.7.0@, the fixity was set to @infix 4@ to match the fixity of 'Data.Type.Equality.:~:'. class a ~ b + +infix 4 ~, ~~ -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -- | @Coercible@ is a two-parameter class that has instances for types @a@ and @b@ if ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -24,6 +24,10 @@ interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) +- Add an explicit fixity for `(~)` and `(~~)`: + + infix 4 ~, ~~ + ## 0.6.1 (edit as necessary) - Shipped with GHC 8.10.1 ===================================== testsuite/tests/ghci/T18060/T18060.stdout ===================================== @@ -10,3 +10,4 @@ instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’ type (~) :: forall k. k -> k -> Constraint class (a ~ b) => (~) a b -- Defined in ‘GHC.Types’ +infix 4 ~ ===================================== testsuite/tests/ghci/scripts/T10059.stdout ===================================== @@ -1,7 +1,9 @@ type (~) :: forall k. k -> k -> Constraint class (a ~ b) => (~) a b -- Defined in ‘GHC.Types’ +infix 4 ~ (~) :: k -> k -> Constraint type (~) :: forall k. k -> k -> Constraint class (a GHC.Prim.~# b) => (~) a b -- Defined in ‘GHC.Types’ +infix 4 ~ ===================================== testsuite/tests/typecheck/should_compile/T18252.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module T18252 where + +import Data.Type.Equality +import GHC.TypeNats + +eq :: (1 + 2 ~ 3) :~: ((1 + 2) ~ 3) +eq = Refl ===================================== testsuite/tests/typecheck/should_fail/T18252a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module T18252a where + +import Data.Type.Equality +import GHC.TypeNats + +eq :: (a ~ b ~ c) :~: () +eq = Refl ===================================== testsuite/tests/typecheck/should_fail/T18252a.stderr ===================================== @@ -0,0 +1,4 @@ + +T18252a.hs:8:10: + Precedence parsing error + cannot mix ‘~’ [infix 4] and ‘~’ [infix 4] in the same infix expression \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c94c81629ac9159775b8b70baf2c635f0331708 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c94c81629ac9159775b8b70baf2c635f0331708 You're receiving 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 17 12:50:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:50:37 -0400 Subject: [Git][ghc/ghc][master] Make the 'IsString (Const a b)' instance polykinded on 'b' Message-ID: <5f635b9d6597a_80b3f84960846ac1266356d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 1 changed file: - libraries/base/Data/String.hs Changes: ===================================== libraries/base/Data/String.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} @@ -87,7 +89,7 @@ instance (a ~ Char) => IsString [a] where fromString xs = xs -- | @since 4.9.0.0 -deriving instance IsString a => IsString (Const a b) +deriving instance IsString a => IsString (Const a (b :: k)) -- | @since 4.9.0.0 deriving instance IsString a => IsString (Identity a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b612e396ed1141dadfabc8486876abb713628f06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b612e396ed1141dadfabc8486876abb713628f06 You're receiving 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 17 12:51:14 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:51:14 -0400 Subject: [Git][ghc/ghc][master] 3 commits: rts/win32: Fix missing #include's Message-ID: <5f635bc24d97b_80b3f84960846ac126682ba@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 12 changed files: - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/directory - libraries/haskeline - rts/win32/IOManager.c - rts/win32/WorkQueue.c - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/ghc-cabal.cabal - utils/haddock Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -76,7 +76,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.1.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 ===================================== 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 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== 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 ===================================== 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 2a15172bde75ec151a52fef586d1e362d478aae8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b612e396ed1141dadfabc8486876abb713628f06...147bb59826087300f989addfcf79e3956f6ed66b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b612e396ed1141dadfabc8486876abb713628f06...147bb59826087300f989addfcf79e3956f6ed66b You're receiving 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 17 12:51:48 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:51:48 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Make Z-encoding comment into a note Message-ID: <5f635be4ddc32_80b3f84959c94ac126703f2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 2 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Utils/Encoding.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -196,7 +196,8 @@ data FastString = FastString { n_chars :: {-# UNPACK #-} !Int, -- number of chars fs_sbs :: {-# UNPACK #-} !ShortByteString, fs_zenc :: FastZString - -- ^ Lazily computed z-encoding of this string. + -- ^ Lazily computed Z-encoding of this string. See Note [Z-Encoding] in + -- GHC.Utils.Encoding. -- -- Since 'FastString's are globally memoized this is computed at most -- once for any given string. ===================================== compiler/GHC/Utils/Encoding.hs ===================================== @@ -277,7 +277,8 @@ utf8EncodedLength str = go 0 str | otherwise = go (n+4) cs -- ----------------------------------------------------------------------------- --- The Z-encoding +-- Note [Z-Encoding] +-- ~~~~~~~~~~~~~~~~~ {- This is the main name-encoding and decoding function. It encodes any View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/147bb59826087300f989addfcf79e3956f6ed66b...c12b3041e533962b8d0ac9ee44e928f874c11671 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/147bb59826087300f989addfcf79e3956f6ed66b...c12b3041e533962b8d0ac9ee44e928f874c11671 You're receiving 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 17 12:52:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:52:25 -0400 Subject: [Git][ghc/ghc][master] Parser.y: clarify treatment of @{-# UNPACK #-} Message-ID: <5f635c091eb1a_80b3f84696094d8126732eb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1981,7 +1981,7 @@ ftype :: { forall b. DisambTD b => PV (Located b) } | tyop { failOpFewArgs $1 } | ftype tyarg { $1 >>= \ $1 -> mkHsAppTyPV $1 $2 } - | ftype PREFIX_AT tyarg { $1 >>= \ $1 -> + | ftype PREFIX_AT atype { $1 >>= \ $1 -> mkHsAppKindTyPV $1 (getLoc $2) $3 } tyarg :: { LHsType GhcPs } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f461e1a31263f052effd03738b11ea123512cb0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f461e1a31263f052effd03738b11ea123512cb0 You're receiving 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 17 12:53:03 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 08:53:03 -0400 Subject: [Git][ghc/ghc][master] Documented '-m' flags for machine specific instruction extensions. Message-ID: <5f635c2fd0ddf_80b10a4418c126795d3@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - 2 changed files: - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/using.rst Changes: ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -108,16 +108,6 @@ -instantiated-with -keep-hi-file -keep-o-file --mavx --mavx2 --mavx512cd --mavx512er --mavx512f --mavx512pf --mbmi --msse --msse3 --msse4 -n -no-auto -no-auto-all ===================================== docs/users_guide/using.rst ===================================== @@ -1284,6 +1284,103 @@ Platform-specific Flags Some flags only make sense for particular target platforms. +.. ghc-flag:: -mavx + :shortdesc: (x86 only) Enable support for AVX SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -mavx2 + :shortdesc: (x86 only) Enable support for AVX2 SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX2 if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -mavx512cd + :shortdesc: (x86 only) Enable support for AVX512-CD SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX512 if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -mavx512er + :shortdesc: (x86 only) Enable support for AVX512-ER SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX512 if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -mavx512f + :shortdesc: (x86 only) Enable support for AVX512-F SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX512 if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -mavx512pf + :shortdesc: (x86 only) Enable support for AVX512-PF SIMD extensions + :type: dynamic + :category: platform-options + + (x86 only) These SIMD instructions are currently not supported by + the :ref:`native code generator `. Enabling this flag + has no effect and is only present for future extensions. + + The :ref:`LLVM backend ` may use AVX512 if your + processor supports it, but detects this automatically, so no flag is + required. + +.. ghc-flag:: -msse + :shortdesc: (x86 only) Use SSE for floating-point operations + :type: dynamic + :category: platform-options + + (x86 only) Use the SSE registers and + instruction set to implement floating point operations when using + the :ref:`native code generator `. This gives a + substantial performance improvement for floating point, but the + resulting compiled code will only run on processors that support + SSE (Intel Pentium 3 and later, or AMD Athlon XP and later). The + :ref:`LLVM backend ` will also use SSE if your + processor supports it but detects this automatically so no flag is + required. + + Since GHC 8.10, SSE2 is assumed to be present on both + x86 and x86-64 platforms and will be used by default. + Even when setting this flag, SSE2 will be used instead. + .. ghc-flag:: -msse2 :shortdesc: (x86 only) Use SSE2 for floating-point operations :type: dynamic @@ -1299,7 +1396,40 @@ Some flags only make sense for particular target platforms. processor supports it but detects this automatically so no flag is required. - SSE2 is unconditionally used on x86-64 platforms. + Since GHC 8.10, SSE2 is assumed to be present on both + x86 and x86-64 platforms and will be used by default. + +.. ghc-flag:: -msse3 + :shortdesc: (x86 only) Use SSE3 for floating-point operations + :type: dynamic + :category: platform-options + + (x86 only) Use the SSE3 instruction set to + implement some floating point and bit operations when using the + :ref:`native code generator `. + + Note that the current version does not use SSE3 specific instructions + and only requires SSE2 processor support. + + The :ref:`LLVM backend ` will also use + SSE3 if your processor supports it but detects this automatically + so no flag is required. + +.. ghc-flag:: -msse4 + :shortdesc: (x86 only) Use SSE4 for floating-point operations + :type: dynamic + :category: platform-options + + (x86 only) Use the SSE4 instruction set to + implement some floating point and bit operations when using the + :ref:`native code generator `. + + Note that the current version does not use SSE4 specific instructions + and only requires SSE2 processor support. + + The :ref:`LLVM backend ` will also use + SSE4 if your processor supports it but detects this automatically + so no flag is required. .. ghc-flag:: -msse4.2 :shortdesc: (x86 only) Use SSE4.2 for floating-point operations @@ -1314,6 +1444,17 @@ Some flags only make sense for particular target platforms. SSE4.2 if your processor supports it but detects this automatically so no flag is required. +.. ghc-flag:: -mbmi + :shortdesc: (x86 only) Use BMI1 for bit manipulation operations + :type: dynamic + :category: platform-options + + (x86 only) Use the BMI1 instruction set to implement some bit operations + when using the :ref:`native code generator `. + + Note that the current version does not use BMI specific instructions, + so using this flag has no effect. + .. ghc-flag:: -mbmi2 :shortdesc: (x86 only) Use BMI2 for bit manipulation operations :type: dynamic View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dec8600ad4734607bea2b4dc3b40a5af788996b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dec8600ad4734607bea2b4dc3b40a5af788996b You're receiving 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 17 12:57:06 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 17 Sep 2020 08:57:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/rts_sizes Message-ID: <5f635d22eed0c_80b3f84678e6c4812682465@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/rts_sizes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/rts_sizes You're receiving 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 17 13:05:58 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Thu, 17 Sep 2020 09:05:58 -0400 Subject: [Git][ghc/ghc][wip/andreask/rts_sizes] Fix a codeblock in ghci.rst Message-ID: <5f635f3692907_80b3f84593b294c126894dc@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/rts_sizes at Glasgow Haskell Compiler / GHC Commits: 3c0be856 by Andreas Klebinger at 2020-09-17T15:05:27+02:00 Fix a codeblock in ghci.rst - - - - - 1 changed file: - docs/users_guide/ghci.rst Changes: ===================================== docs/users_guide/ghci.rst ===================================== @@ -2564,6 +2564,7 @@ commonly used commands. be used. .. code-block:: none + ghci>:set -XDataKinds -XUndecidableInstances ghci>import GHC.TypeLits ghci>class A a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c0be85606648205bbee80a705b9b6d15ef06633 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c0be85606648205bbee80a705b9b6d15ef06633 You're receiving 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 17 13:23:57 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 09:23:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Added explicit fixity to (~). Message-ID: <5f63636dc41d7_80b3f8468ee8a0012694524@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - f0bdd5eb by Sylvain Henry at 2020-09-17T09:23:49-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - d3f289f9 by Sylvain Henry at 2020-09-17T09:23:49-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 400958a8 by Sylvain Henry at 2020-09-17T09:23:49-04:00 Add note about OutputableP - - - - - 4895d0db by Sylvain Henry at 2020-09-17T09:23:49-04:00 Remove pprPrec from Outputable (unused) - - - - - bd73fa40 by Sylvain Henry at 2020-09-17T09:23:51-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 30 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffa2045c5b08014dab04ccbdd94dd82aecfd0552...bd73fa40bf83d4f37b69f1bcda30152a84413aa1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ffa2045c5b08014dab04ccbdd94dd82aecfd0552...bd73fa40bf83d4f37b69f1bcda30152a84413aa1 You're receiving 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 17 13:55:37 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Thu, 17 Sep 2020 09:55:37 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 5 commits: Use `exitMyTask()` instead of `freeTask()` in `rts_unpause()` Message-ID: <5f636ad969d04_80b3f84593b294c12704619@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 2f8ca0e5 by David Eichmann at 2020-09-14T15:26:20+01:00 Use `exitMyTask()` instead of `freeTask()` in `rts_unpause()` - - - - - 781607b2 by David Eichmann at 2020-09-14T17:06:25+01:00 Correct documentation for Task_::stopped - - - - - a5d9429f by David Eichmann at 2020-09-16T20:21:56+01:00 Improve documentation - - - - - 56596dd7 by David Eichmann at 2020-09-17T14:47:46+01:00 Record and restor owned capability on pause/unpause - - - - - b7e42c0a by David Eichmann at 2020-09-17T14:49:52+01:00 Add tests for calling ghc-debug API via safe/unsafe FFI call and via a new thread - - - - - 12 changed files: - includes/RtsAPI.h - rts/Capability.c - rts/Printer.c - rts/RtsAPI.c - rts/Schedule.c - rts/Task.h - testsuite/tests/rts/ghc-debug/all.T - testsuite/tests/rts/ghc-debug/pause_and_unpause.hs → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.h → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h - + testsuite/tests/rts/ghc-debug/shouldfail/all.T - + testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs Changes: ===================================== includes/RtsAPI.h ===================================== @@ -488,21 +488,28 @@ SchedulerStatus rts_getSchedStatus (Capability *cap); // Various bits of information that need to be persisted between rts_pause and // rts_unpause. typedef struct RtsPaused_ { + // The task (i.e. OS thread) on which rts_pause() was called. This is used + // in rts_unpause() to check that it is called on the same OS thread. Task *pausing_task; - Capability *capabilities; + + // The capability owned by pausing_task (possibly NULL) just before calling + // rts_unpause(). On rts_unpause(), the pausing_task will retain ownership + // of this capability (if not NULL). + Capability *capability; } RtsPaused; -// Halt execution of all Haskell threads. -// It is different to rts_lock because it pauses all capabilities. rts_lock -// only pauses a single capability. -// rts_pause() and rts_unpause() have to be executed from the same OS thread -// (i.e. myTask() must stay the same). +// Halt execution of all Haskell threads by acquiring all capabilities. It is +// different to rts_lock() because rts_pause() pauses all capabilities while +// rts_lock() only pauses a single capability. rts_pause() and rts_unpause() +// have to be executed from the same OS thread (i.e. myTask() must stay the +// same). Returns the currently owned capability (possibly NULL). This must be +// passed back to rts_unpause(). RtsPaused rts_pause (void); // Counterpart of rts_pause: Continue from a pause. // rts_pause() and rts_unpause() have to be executed from the same OS thread // (i.e. myTask() must stay the same). -void rts_unpause (RtsPaused paused); +void rts_unpause (RtsPaused); // Tells the current state of the RTS regarding rts_pause() and rts_unpause(). bool rts_isPaused(void); ===================================== rts/Capability.c ===================================== @@ -858,7 +858,13 @@ void waitForCapability (Capability **pCap, Task *task) /* See Note [GC livelock] in Schedule.c for why we have gcAllowed and return the bool */ bool /* Did we GC? */ -yieldCapability (Capability** pCap, Task *task, bool gcAllowed) +yieldCapability + ( Capability** pCap // [in/out] Task's currently owned capability + // pCap != NULL + // *pCap != NULL + , Task *task // [in] This thread's task. + , bool gcAllowed + ) { Capability *cap = *pCap; ===================================== rts/Printer.c ===================================== @@ -861,32 +861,60 @@ findPtr_default_callback(void *user STG_UNUSED, StgClosure * closure){ int searched = 0; +// Search through a block (and it's linked blocks) for closures that reference +// p. The size of arr is respected and the search is stoped when arr is full. +// TODO: This may produce false positives if e.g. a closure contains an Int that +// happens to have the same value as memory address p. Returns the new i value +// i.e. the next free position in the arr array. static int -findPtrBlocks (FindPtrCb cb, void* user, StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i) +findPtrBlocks + ( FindPtrCb cb // [in] callback called whenever a closure referencing p is found. + , void* user // [in] unused other than to pass to the callback. + , StgPtr p // [in] The pointer to search for. + , bdescr *bd // [in] The block descriptor of the block from which to start searching. + , StgPtr arr[] // [in/out] All found closure addresses are written into this array. + , int arr_size // [in] The size of arr. + , int i // [in] The current position in arr. + ) { - StgPtr q, r, end; + StgPtr candidate, retainer, end; + + // Iterate over all blocks. for (; bd; bd = bd->link) { searched++; - for (q = bd->start; q < bd->free; q++) { - if (UNTAG_CONST_CLOSURE((StgClosure*)*q) == (const StgClosure *)p) { + // Scan the block looking for a pointer equal to p. + for (candidate = bd->start; candidate < bd->free; candidate++) { + if (UNTAG_CONST_CLOSURE((StgClosure*)*candidate) == (const StgClosure *)p) { + // *candidate looks like a pointer equal to p, but it might not + // be a pointer type i.e. it may just be an Int that happens to + // have the same value as memory address p. + + // We stop if the output array is full. if (i < arr_size) { - for (r = bd->start; r < bd->free; r = end) { + for (retainer = bd->start; retainer < bd->free; retainer = end) { // skip over zeroed-out slop - while (*r == 0) r++; - if (!LOOKS_LIKE_CLOSURE_PTR(r)) { + while (*retainer == 0) retainer++; + + // A quick check that retainer looks like a InfoTable pointer. + if (!LOOKS_LIKE_CLOSURE_PTR(retainer)) { debugBelch("%p found at %p, no closure at %p\n", - p, q, r); + p, candidate, retainer); break; } - end = r + closure_sizeW((StgClosure*)r); - if (q < end) { - cb(user, (StgClosure *) r); - arr[i++] = r; + end = retainer + closure_sizeW((StgClosure*)retainer); + if (candidate < end) { + // end has just increased past candidate. Hence + // candidate is in the closure starting at retainer. + cb(user, (StgClosure *) retainer); + arr[i++] = retainer; break; } } - if (r >= bd->free) { - debugBelch("%p found at %p, closure?", p, q); + if (retainer >= bd->free) { + // TODO: How is this case reachable? Perhaps another + // thread overwrote *q after we found q and before we + // found the corresponding closure retainer. + debugBelch("%p found at %p, closure?", p, candidate); } } else { return i; @@ -897,8 +925,19 @@ findPtrBlocks (FindPtrCb cb, void* user, StgPtr p, bdescr *bd, StgPtr arr[], int return i; } +// Search for for closures that reference p. This may NOT find all such closures +// (e.g. the nursery is not searched). This may also find false positives if +// e.g. a closure contains an Int that happens to have the same value as memory +// address p. The number of results is capped at 1024. The callback is called +// for each closure found. static void -findPtr_gen(FindPtrCb cb, void *user, P_ p, int follow) +findPtr_gen + ( FindPtrCb cb // [in] Callback called for each closure found referencing p. + , void *user // [in] Unused other than to pass to the callback. + , P_ p // [in] Search for closures referencing this address. + , int follow // [in] If set to 1 and only a single closure was found, + // recursively find pointers to that if to recurse (call findPtr on the ). May only be 1 if cb==findPtr_default_callback. + ) { uint32_t g, n; bdescr *bd; ===================================== rts/RtsAPI.c ===================================== @@ -648,31 +648,51 @@ rts_unlock (Capability *cap) #if defined(THREADED_RTS) static bool rts_paused = false; -// Halt execution of all Haskell threads. -// It is different to rts_lock because it pauses all capabilities. rts_lock -// only pauses a single capability. -// rts_pause() and rts_unpause() have to be executed from the same OS thread -// (i.e. myTask() must stay the same). + +// See RtsAPI.h RtsPaused rts_pause (void) { - struct RtsPaused_ paused; - paused.pausing_task = newBoundTask(); - stopAllCapabilities(&paused.capabilities, paused.pausing_task); + if (rts_isPaused()) + { + errorBelch("error: rts_pause: attempting to pause an already paused RTS."); + stg_exit(EXIT_FAILURE); + } + + RtsPaused rtsPaused; + rtsPaused.pausing_task = newBoundTask(); + + // Check if we own a capability. This is needed to correctly call + // stopAllCapabilities() and to know if to keep ownership or release the + // capability on rts_unpause(). + Capability * cap = rtsPaused.pausing_task->cap; + bool taskOwnsCap = cap != NULL && cap->running_task == rtsPaused.pausing_task; + rtsPaused.capability = taskOwnsCap ? cap : NULL; + stopAllCapabilities(taskOwnsCap ? &rtsPaused.capability : NULL, rtsPaused.pausing_task); + rts_paused = true; - return paused; + return rtsPaused; } -// Counterpart of rts_pause: Continue from a pause. -// rts_pause() and rts_unpause() have to be executed from the same OS thread -// (i.e. myTask() must stay the same). -void rts_unpause (RtsPaused paused) +// See RtsAPI.h +void rts_unpause (RtsPaused rtsPaused) { + if (!rts_isPaused()) + { + errorBelch("error: rts_pause: attempting to resume an RTS that is not paused."); + stg_exit(EXIT_FAILURE); + } + if (rtsPaused.pausing_task != getMyTask()) + { + errorBelch("error: rts_unpause was called from a different OS thread than rts_pause."); + stg_exit(EXIT_FAILURE); + } + rts_paused = false; - releaseAllCapabilities(n_capabilities, paused.capabilities, paused.pausing_task); - freeTask(paused.pausing_task); + releaseAllCapabilities(n_capabilities, rtsPaused.capability, getMyTask()); + exitMyTask(); } -// Tells the current state of the RTS regarding rts_pause() and rts_unpause(). +// See RtsAPI.h bool rts_isPaused(void) { return rts_paused; @@ -684,7 +704,6 @@ bool rts_isPaused(void) // was called before. void rts_listThreads(ListThreadsCb cb, void *user) { - ASSERT(rts_paused); for (uint32_t g=0; g < RtsFlags.GcFlags.generations; g++) { StgTSO *tso = generations[g].threads; while (tso != END_TSO_QUEUE) { @@ -716,7 +735,6 @@ void rts_listMiscRoots (ListRootsCb cb, void *user) ctx.cb = cb; ctx.user = user; - ASSERT(rts_paused); threadStableNameTable(&list_roots_helper, (void *)&ctx); threadStablePtrTable(&list_roots_helper, (void *)&ctx); } @@ -726,19 +744,20 @@ RtsPaused rts_pause (void) { errorBelch("Warning: Pausing the RTS is only possible for " "multithreaded RTS."); - struct RtsPaused_ paused; - paused.pausing_task = NULL; - paused.capabilities = NULL; - return paused; + RtsPaused rtsPaused = { + .pausing_task = NULL, + .capability = NULL + }; + return rtsPaused; } -void rts_unpause (RtsPaused paused STG_UNUSED) +void rts_unpause (RtsPaused cap STG_UNUSED) { errorBelch("Warning: Unpausing the RTS is only possible for " "multithreaded RTS."); } -bool rts_isPaused(void) +bool rts_isPaused() { errorBelch("Warning: (Un-) Pausing the RTS is only possible for " "multithreaded RTS."); ===================================== rts/Schedule.c ===================================== @@ -1411,7 +1411,15 @@ scheduleNeedHeapProfile( bool ready_to_gc ) * -------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -void stopAllCapabilities (Capability **pCap, Task *task) +void stopAllCapabilities + ( Capability **pCap // [in/out] This thread's task's owned capability. + // pCap may be NULL if no capability is owned. + // *pCap != NULL + // On return, set to the task's newly owned + // capability (task->cap). Though, the Task will + // technically own all capabilities. + , Task *task // [in] This thread's task. + ) { stopAllCapabilitiesWith(pCap, task, SYNC_OTHER); } @@ -1463,9 +1471,15 @@ void stopAllCapabilitiesWith (Capability **pCap, Task *task, SyncType sync_type) * -------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -static bool requestSync ( - Capability **pcap, Task *task, PendingSync *new_sync, - SyncType *prev_sync_type) +static bool requestSync + ( Capability **pcap // [in/out] This thread's task's owned capability. + // May change if there is an existing sync (true is returned). + // pcap may be NULL + // *pcap != NULL + , Task *task // [in] This thread's task. + , PendingSync *new_sync // [in] The new requested synch. + , SyncType *prev_sync_type // [out] Only set if there is an existing previous sync (true is returned). + ) { PendingSync *sync; ===================================== rts/Task.h ===================================== @@ -149,7 +149,7 @@ typedef struct Task_ { struct InCall_ *spare_incalls; bool worker; // == true if this is a worker Task - bool stopped; // == true between newBoundTask and + bool stopped; // == false between newBoundTask and // exitMyTask, or in a worker Task. // So that we can detect when a finalizer illegally calls back into Haskell ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,6 +1,6 @@ -test('pause_and_unpause', - [ extra_files(['pause_and_unpause_thread.c','pause_and_unpause_thread.h']), +test('rts_pause_and_unpause', + [ extra_files(['rts_pause_and_unpause_c.c','rts_pause_and_unpause_c.h']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['pause_and_unpause', [('pause_and_unpause_thread.c','')], '-threaded']) + multi_compile_and_run, ['rts_pause_and_unpause', [('rts_pause_and_unpause_c.c','')], '-threaded ']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause.hs → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs ===================================== @@ -8,23 +8,30 @@ import Foreign.C.Types import System.Mem import Control.Monad -foreign import ccall safe "pause_and_unpause_thread.h pauseAndUnpause" - pauseAndUnpause_c :: IO () +foreign import ccall safe "rts_pause_and_unpause_c.h pauseAndUnpause" + safe_pauseAndUnpause_c :: IO () -foreign import ccall safe "pause_and_unpause_thread.h getUnixTime" +foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpause" + unsafe_pauseAndUnpause_c :: IO () + +foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpauseViaNewThread" + unsafe_pauseAndUnpauseViaNewThread_c :: IO () + +-- Note that these should be unsafe FFI calls. rts_pause() does not pause or +-- wait for safe FFI calls, as they do not own a capability. +foreign import ccall unsafe "rts_pause_and_unpause_c.h getUnixTime" getUnixTime_c :: IO CTime -foreign import ccall safe "pause_and_unpause_thread.h getPauseBegin" +foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseBegin" getPauseBegin_c :: IO CTime -foreign import ccall safe "pause_and_unpause_thread.h getPauseEnd" +foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseEnd" getPauseEnd_c :: IO CTime clockEachSecond :: IORef [CTime] -> IO () clockEachSecond ref = forever $ do time <- getUnixTime_c - timesList <- readIORef ref - writeIORef ref $ time : timesList + modifyIORef ref $ (time:) sleepSeconds 1 @@ -35,12 +42,30 @@ the list that is in this 5 Seconds wide timeframe, which is defined by getPauseBegin_c and getPauseEnd_c. -} main :: IO () main = do - ref <- newIORef [] - forkIO $ clockEachSecond ref + -- Start thread that forever writes the current time to an IORef + ref <- newIORef [] + forkIO $ clockEachSecond ref - sleepSeconds 3 + -- Attempt pause and unpause in various forms + withPauseAndUnpause ref + "Pause and unpause via safe FFI call" + safe_pauseAndUnpause_c + + withPauseAndUnpause ref + "Pause and unpause via unsafe FFI call" + unsafe_pauseAndUnpause_c - pauseAndUnpause_c + withPauseAndUnpause ref + "Pause and unpause via unsafe FFI call that creates a new OS thread" + unsafe_pauseAndUnpauseViaNewThread_c + +withPauseAndUnpause :: IORef [CTime] -> String -> IO () -> IO () +withPauseAndUnpause ref startMsg pauseAndUnpause = do + putStrLn startMsg + + writeIORef ref [] + sleepSeconds 3 + pauseAndUnpause -- This seems to sleep for 8 - 5 Seconds. That's strange, but should be -- good enough for this test. @@ -56,7 +81,7 @@ main = do filter (\t -> t <= pauseBegin) times `shouldNotBe` [] filter (\t -> t >= pauseEnd) times `shouldNotBe` [] - return () + putStrLn "DONE" sleepSeconds :: Int -> IO () sleepSeconds t = threadDelay $ oneSecondInMicroSeconds * t ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c ===================================== @@ -1,7 +1,7 @@ #include #include #include -#include "pause_and_unpause_thread.h" +#include "rts_pause_and_unpause_c.h" #include "Rts.h" #include "RtsAPI.h" @@ -10,7 +10,7 @@ struct PauseTimestamps timestamps = {0, 0}; void* pauseAndUnpause_thread(void* unused){ - RtsPaused r_paused = rts_pause(); + RtsPaused rtsPaused = rts_pause(); if(!rts_isPaused()) { errorBelch("Expected the RTS to be paused."); @@ -21,7 +21,7 @@ void* pauseAndUnpause_thread(void* unused){ sleep(5); timestamps.end = time(NULL); - rts_unpause(r_paused); + rts_unpause(rtsPaused); if(rts_isPaused()) { errorBelch("Expected the RTS to be unpaused."); @@ -32,6 +32,10 @@ void* pauseAndUnpause_thread(void* unused){ } void pauseAndUnpause(void){ + pauseAndUnpause_thread(NULL); +} + +void pauseAndUnpauseViaNewThread(void){ pthread_t threadId; pthread_create(&threadId, NULL, &pauseAndUnpause_thread, NULL); pthread_detach(threadId); ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.h → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h ===================================== ===================================== testsuite/tests/rts/ghc-debug/shouldfail/all.T ===================================== @@ -0,0 +1 @@ +test('unsafe_rts_pause', normal, compile_and_run, ['-threaded ']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Data.Word +import Data.IORef +import GHC.Clock +import Control.Concurrent +import Foreign.Ptr +import System.Mem +import Control.Monad + +data RtsPause + +foreign import ccall unsafe "RtsAPI.h rts_pause" + unsafe_rts_pause_c :: IO (Ptr RtsPause) + +main :: IO () +main = do + putStrLn "Making a unsafe call to rts_pause() should fail on return. We \ + \cannot allow this haskell thread to continue if the RTS is paused." + _ <- unsafe_rts_pause_c + putStrLn "Oops! Haskell thread has continued even though RTS was paused." \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b8f2a147e7df9a57cdcbd61c9ae1f7a9c0eb0e...b7e42c0a0181a5bb8e57fcef2547a7b045821e54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8b8f2a147e7df9a57cdcbd61c9ae1f7a9c0eb0e...b7e42c0a0181a5bb8e57fcef2547a7b045821e54 You're receiving 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 17 14:02:22 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Thu, 17 Sep 2020 10:02:22 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] Add tests for calling ghc-debug API via safe/unsafe FFI call and via a new thread Message-ID: <5f636c6e26497_80b3f849638412c1270696@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 47b915a1 by David Eichmann at 2020-09-17T15:02:11+01:00 Add tests for calling ghc-debug API via safe/unsafe FFI call and via a new thread - - - - - 6 changed files: - testsuite/tests/rts/ghc-debug/all.T - testsuite/tests/rts/ghc-debug/pause_and_unpause.hs → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.h → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h - + testsuite/tests/rts/ghc-debug/shouldfail/all.T - + testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs Changes: ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,6 +1,6 @@ -test('pause_and_unpause', - [ extra_files(['pause_and_unpause_thread.c','pause_and_unpause_thread.h']), +test('rts_pause_and_unpause', + [ extra_files(['rts_pause_and_unpause_c.c','rts_pause_and_unpause_c.h']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['pause_and_unpause', [('pause_and_unpause_thread.c','')], '-threaded']) + multi_compile_and_run, ['rts_pause_and_unpause', [('rts_pause_and_unpause_c.c','')], '-threaded ']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause.hs → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs ===================================== @@ -8,23 +8,30 @@ import Foreign.C.Types import System.Mem import Control.Monad -foreign import ccall safe "pause_and_unpause_thread.h pauseAndUnpause" - pauseAndUnpause_c :: IO () +foreign import ccall safe "rts_pause_and_unpause_c.h pauseAndUnpause" + safe_pauseAndUnpause_c :: IO () -foreign import ccall safe "pause_and_unpause_thread.h getUnixTime" +foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpause" + unsafe_pauseAndUnpause_c :: IO () + +foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpauseViaNewThread" + unsafe_pauseAndUnpauseViaNewThread_c :: IO () + +-- Note that these should be unsafe FFI calls. rts_pause() does not pause or +-- wait for safe FFI calls, as they do not own a capability. +foreign import ccall unsafe "rts_pause_and_unpause_c.h getUnixTime" getUnixTime_c :: IO CTime -foreign import ccall safe "pause_and_unpause_thread.h getPauseBegin" +foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseBegin" getPauseBegin_c :: IO CTime -foreign import ccall safe "pause_and_unpause_thread.h getPauseEnd" +foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseEnd" getPauseEnd_c :: IO CTime clockEachSecond :: IORef [CTime] -> IO () clockEachSecond ref = forever $ do time <- getUnixTime_c - timesList <- readIORef ref - writeIORef ref $ time : timesList + modifyIORef ref $ (time:) sleepSeconds 1 @@ -35,12 +42,30 @@ the list that is in this 5 Seconds wide timeframe, which is defined by getPauseBegin_c and getPauseEnd_c. -} main :: IO () main = do - ref <- newIORef [] - forkIO $ clockEachSecond ref + -- Start thread that forever writes the current time to an IORef + ref <- newIORef [] + forkIO $ clockEachSecond ref - sleepSeconds 3 + -- Attempt pause and unpause in various forms + withPauseAndUnpause ref + "Pause and unpause via safe FFI call" + safe_pauseAndUnpause_c + + withPauseAndUnpause ref + "Pause and unpause via unsafe FFI call" + unsafe_pauseAndUnpause_c - pauseAndUnpause_c + withPauseAndUnpause ref + "Pause and unpause via unsafe FFI call that creates a new OS thread" + unsafe_pauseAndUnpauseViaNewThread_c + +withPauseAndUnpause :: IORef [CTime] -> String -> IO () -> IO () +withPauseAndUnpause ref startMsg pauseAndUnpause = do + putStrLn startMsg + + writeIORef ref [] + sleepSeconds 3 + pauseAndUnpause -- This seems to sleep for 8 - 5 Seconds. That's strange, but should be -- good enough for this test. @@ -56,7 +81,7 @@ main = do filter (\t -> t <= pauseBegin) times `shouldNotBe` [] filter (\t -> t >= pauseEnd) times `shouldNotBe` [] - return () + putStrLn "DONE" sleepSeconds :: Int -> IO () sleepSeconds t = threadDelay $ oneSecondInMicroSeconds * t ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c ===================================== @@ -1,7 +1,7 @@ #include #include #include -#include "pause_and_unpause_thread.h" +#include "rts_pause_and_unpause_c.h" #include "Rts.h" #include "RtsAPI.h" @@ -9,8 +9,8 @@ struct PauseTimestamps timestamps = {0, 0}; -void pauseAndUnpause(void){ - RtsPaused r_paused = rts_pause(); +void* pauseAndUnpause_thread(void* unused){ + RtsPaused rtsPaused = rts_pause(); if(!rts_isPaused()) { errorBelch("Expected the RTS to be paused."); @@ -21,7 +21,7 @@ void pauseAndUnpause(void){ sleep(5); timestamps.end = time(NULL); - rts_unpause(r_paused); + rts_unpause(rtsPaused); if(rts_isPaused()) { errorBelch("Expected the RTS to be unpaused."); @@ -31,6 +31,16 @@ void pauseAndUnpause(void){ return NULL; } +void pauseAndUnpause(void){ + pauseAndUnpause_thread(NULL); +} + +void pauseAndUnpauseViaNewThread(void){ + pthread_t threadId; + pthread_create(&threadId, NULL, &pauseAndUnpause_thread, NULL); + pthread_detach(threadId); +} + time_t getPauseBegin(void) { return timestamps.begin; } ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.h → testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h ===================================== ===================================== testsuite/tests/rts/ghc-debug/shouldfail/all.T ===================================== @@ -0,0 +1 @@ +test('unsafe_rts_pause', [ignore_stderr, exit_code(134)], compile_and_run, ['-threaded ']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs ===================================== @@ -0,0 +1,21 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Data.Word +import Data.IORef +import GHC.Clock +import Control.Concurrent +import Foreign.Ptr +import System.Mem +import Control.Monad + +data RtsPause + +foreign import ccall unsafe "RtsAPI.h rts_pause" + unsafe_rts_pause_c :: IO (Ptr RtsPause) + +main :: IO () +main = do + putStrLn "Making a unsafe call to rts_pause() should fail on return. We \ + \cannot allow this haskell thread to continue if the RTS is paused." + _ <- unsafe_rts_pause_c + putStrLn "Oops! Haskell thread has continued even though RTS was paused." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47b915a196db03d57ca3358a7c03e6ab97e7aac4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47b915a196db03d57ca3358a7c03e6ab97e7aac4 You're receiving 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 17 14:48:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 10:48:28 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/docs-fixes Message-ID: <5f63773cc4536_80ba8142b4127112f9@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/docs-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/docs-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 Thu Sep 17 14:48:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 10:48:58 -0400 Subject: [Git][ghc/ghc][wip/docs-fixes] docs: Fix various documentation issues Message-ID: <5f63775a1b116_80b3f8473141a181271143f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/docs-fixes at Glasgow Haskell Compiler / GHC Commits: 195ad0f8 by Ben Gamari at 2020-09-17T10:48:50-04:00 docs: Fix various documentation issues - - - - - 5 changed files: - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/instances.rst - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -49,9 +49,10 @@ Highlights - 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 - not used anymore + + - gmp: adapted from integer-gmp package that was used before + - 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 ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -37,9 +37,9 @@ Notes: instance forall a. Eq a => Eq [a] where ... - Note that the use of ``forall``s in instance declarations is somewhat + Note that the use of ``forall``\s in instance declarations is somewhat restricted in comparison to other types. For example, instance declarations - are not allowed to contain nested ``forall``s. See + are not allowed to contain nested ``forall``\s. See :ref:`formal-instance-syntax` for more information. - If the :ghc-flag:`-Wunused-foralls` flag is enabled, a warning will be emitted ===================================== docs/users_guide/exts/instances.rst ===================================== @@ -141,22 +141,22 @@ Where: - ``btype`` is a type that is not allowed to have an outermost ``forall``/``=>`` unless it is surrounded by parentheses. For example, - ``forall a. a`` and ``Eq a => a`` are not legal ``btype``s, but + ``forall a. a`` and ``Eq a => a`` are not legal ``btype``\s, but ``(forall a. a)`` and ``(Eq a => a)`` are legal. - ``ctype`` is a ``btype`` that has no restrictions on an outermost - ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``s. -- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``s + ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\s. +- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``\s - ``prefix_cls_tycon`` is a class type constructor written prefix (e.g., ``Show`` or ``(&&&)``), while ``infix_cls_tycon`` is a class type constructor - written infix (e.g., ```Show``` or ``&&&``). + written infix (e.g., ``\`Show\``` or ``&&&``). This is a simplified grammar that does not fully delve into all of the implementation details of GHC's parser (such as the placement of Haddock comments), but it is sufficient to attain an understanding of what is syntactically allowed. Some further various observations about this grammar: -- Instance declarations are not allowed to be declared with nested ``forall``s - or ``=>``s. For example, this would be rejected: :: +- Instance declarations are not allowed to be declared with nested ``forall``\s + or ``=>``\s. For example, this would be rejected: :: instance forall a. forall b. C (Either a b) where ... ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.0.1-notes + 9.2.1-notes ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -183,6 +183,10 @@ Event log output Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l ⟨flags⟩`) is written through a custom :c:type:`EventLogWriter`: +.. c:type:: size_t + + :hidden: + .. c:type:: EventLogWriter A sink of event-log data. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/195ad0f8e4b84d38bffd1fab2d2b8e925d48c255 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/195ad0f8e4b84d38bffd1fab2d2b8e925d48c255 You're receiving 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 17 14:56:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 10:56:09 -0400 Subject: [Git][ghc/ghc][wip/docs-fixes] 2 commits: docs: Fix various documentation issues Message-ID: <5f63790921370_80b3f8428e673141271426e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/docs-fixes at Glasgow Haskell Compiler / GHC Commits: a14b8644 by Ben Gamari at 2020-09-17T10:54:53-04:00 docs: Fix various documentation issues - - - - - 1222d3fe by Ben Gamari at 2020-09-17T10:55:00-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - 6 changed files: - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/instances.rst - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -49,9 +49,10 @@ Highlights - 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 - not used anymore + + - gmp: adapted from integer-gmp package that was used before + - 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 ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -37,9 +37,9 @@ Notes: instance forall a. Eq a => Eq [a] where ... - Note that the use of ``forall``s in instance declarations is somewhat + Note that the use of ``forall``\s in instance declarations is somewhat restricted in comparison to other types. For example, instance declarations - are not allowed to contain nested ``forall``s. See + are not allowed to contain nested ``forall``\s. See :ref:`formal-instance-syntax` for more information. - If the :ghc-flag:`-Wunused-foralls` flag is enabled, a warning will be emitted ===================================== docs/users_guide/exts/instances.rst ===================================== @@ -141,22 +141,22 @@ Where: - ``btype`` is a type that is not allowed to have an outermost ``forall``/``=>`` unless it is surrounded by parentheses. For example, - ``forall a. a`` and ``Eq a => a`` are not legal ``btype``s, but + ``forall a. a`` and ``Eq a => a`` are not legal ``btype``\s, but ``(forall a. a)`` and ``(Eq a => a)`` are legal. - ``ctype`` is a ``btype`` that has no restrictions on an outermost - ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``s. -- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``s + ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\s. +- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``\s - ``prefix_cls_tycon`` is a class type constructor written prefix (e.g., ``Show`` or ``(&&&)``), while ``infix_cls_tycon`` is a class type constructor - written infix (e.g., ```Show``` or ``&&&``). + written infix (e.g., ``\`Show\``` or ``&&&``). This is a simplified grammar that does not fully delve into all of the implementation details of GHC's parser (such as the placement of Haddock comments), but it is sufficient to attain an understanding of what is syntactically allowed. Some further various observations about this grammar: -- Instance declarations are not allowed to be declared with nested ``forall``s - or ``=>``s. For example, this would be rejected: :: +- Instance declarations are not allowed to be declared with nested ``forall``\s + or ``=>``\s. For example, this would be rejected: :: instance forall a. forall b. C (Either a b) where ... ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.0.1-notes + 9.2.1-notes ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -183,6 +183,13 @@ Event log output Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l ⟨flags⟩`) is written through a custom :c:type:`EventLogWriter`: +.. The size_t declaration below is simply to ensure that the build doesn't fail with an + undefined reference target warning as Sphinx doesn't know about size_t. + +.. c:type:: size_t + + :hidden: + .. c:type:: EventLogWriter A sink of event-log data. ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -127,6 +127,21 @@ checkSphinxWarnings :: FilePath -- ^ output directory -> Action () checkSphinxWarnings out = do log <- liftIO $ readFile (out -/- ".log") + when ("Inline literal start-string without end-string." `isInfixOf` log) + $ fail $ unlines + [ "Syntax error found in Sphinx log. " + , "" + , "This likely means that you have forgotten a \\ after inline code block. For instance," + , "you might have written:" + , "" + , " are not allowed to contain nested ``forall``s." + , "" + , "Whereas you need to write:" + , "" + , " are not allowed to contain nested ``forall``\s." + , "" + ] + when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/195ad0f8e4b84d38bffd1fab2d2b8e925d48c255...1222d3fe435b63988dc5d13c7deb3b211de1225c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/195ad0f8e4b84d38bffd1fab2d2b8e925d48c255...1222d3fe435b63988dc5d13c7deb3b211de1225c You're receiving 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 17 14:59:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 10:59:37 -0400 Subject: [Git][ghc/ghc][wip/docs-fixes] 2 commits: users guide: Fix various documentation issues Message-ID: <5f6379d9d81a2_80b11062140127146f6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/docs-fixes at Glasgow Haskell Compiler / GHC Commits: 12d7b6dd by Ben Gamari at 2020-09-17T10:59:25-04:00 users guide: Fix various documentation issues - - - - - 0847b7b8 by Ben Gamari at 2020-09-17T10:59:31-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - 6 changed files: - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/instances.rst - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -49,9 +49,10 @@ Highlights - 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 - not used anymore + + - gmp: adapted from integer-gmp package that was used before + - 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 ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -37,9 +37,9 @@ Notes: instance forall a. Eq a => Eq [a] where ... - Note that the use of ``forall``s in instance declarations is somewhat + Note that the use of ``forall``\s in instance declarations is somewhat restricted in comparison to other types. For example, instance declarations - are not allowed to contain nested ``forall``s. See + are not allowed to contain nested ``forall``\s. See :ref:`formal-instance-syntax` for more information. - If the :ghc-flag:`-Wunused-foralls` flag is enabled, a warning will be emitted ===================================== docs/users_guide/exts/instances.rst ===================================== @@ -141,22 +141,22 @@ Where: - ``btype`` is a type that is not allowed to have an outermost ``forall``/``=>`` unless it is surrounded by parentheses. For example, - ``forall a. a`` and ``Eq a => a`` are not legal ``btype``s, but + ``forall a. a`` and ``Eq a => a`` are not legal ``btype``\s, but ``(forall a. a)`` and ``(Eq a => a)`` are legal. - ``ctype`` is a ``btype`` that has no restrictions on an outermost - ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``s. -- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``s + ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\s. +- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``\s - ``prefix_cls_tycon`` is a class type constructor written prefix (e.g., ``Show`` or ``(&&&)``), while ``infix_cls_tycon`` is a class type constructor - written infix (e.g., ```Show``` or ``&&&``). + written infix (e.g., ``\`Show\``` or ``&&&``). This is a simplified grammar that does not fully delve into all of the implementation details of GHC's parser (such as the placement of Haddock comments), but it is sufficient to attain an understanding of what is syntactically allowed. Some further various observations about this grammar: -- Instance declarations are not allowed to be declared with nested ``forall``s - or ``=>``s. For example, this would be rejected: :: +- Instance declarations are not allowed to be declared with nested ``forall``\s + or ``=>``\s. For example, this would be rejected: :: instance forall a. forall b. C (Either a b) where ... ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.0.1-notes + 9.2.1-notes ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -183,6 +183,13 @@ Event log output Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l ⟨flags⟩`) is written through a custom :c:type:`EventLogWriter`: +.. The size_t declaration below is simply to ensure that the build doesn't fail with an + undefined reference target warning as Sphinx doesn't know about size_t. + +.. c:type:: size_t + + :hidden: + .. c:type:: EventLogWriter A sink of event-log data. ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -127,6 +127,21 @@ checkSphinxWarnings :: FilePath -- ^ output directory -> Action () checkSphinxWarnings out = do log <- liftIO $ readFile (out -/- ".log") + when ("Inline literal start-string without end-string." `isInfixOf` log) + $ fail $ unlines + [ "Syntax error found in Sphinx log. " + , "" + , "This likely means that you have forgotten a \\ after inline code block. For instance," + , "you might have written:" + , "" + , " are not allowed to contain nested ``forall``s." + , "" + , "Whereas you need to write:" + , "" + , " are not allowed to contain nested ``forall``\s." + , "" + ] + when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1222d3fe435b63988dc5d13c7deb3b211de1225c...0847b7b8a38fa047d362d671dcea3c8989906f8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1222d3fe435b63988dc5d13c7deb3b211de1225c...0847b7b8a38fa047d362d671dcea3c8989906f8b You're receiving 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 17 18:50:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 14:50:11 -0400 Subject: [Git][ghc/ghc][wip/backports] Bump Win32 submodule to 2.9.0.0 Message-ID: <5f63afe32cbaf_80b3f84957c453012736660@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: f67f6d07 by Ben Gamari at 2020-09-17T14:50:02-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory (cherry picked from commit 9c6c1ebc9ab2f18d711a8793c7f0ec36e989d687) - - - - - 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 1d886476c443b227bf93eba62781a6cad5012d9e +Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f67f6d07a7ae2753c48e3c06378900f3fedf3f2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f67f6d07a7ae2753c48e3c06378900f3fedf3f2c You're receiving 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 17 18:50:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 14:50:57 -0400 Subject: [Git][ghc/ghc][wip/backports] 8 commits: testsuite: Only run llvm ways if llc is available Message-ID: <5f63b01124087_80b7583264127370fa@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports 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 - - - - - 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) - - - - - 12d9742c by Zubin Duggal at 2020-09-16T14:38:15-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` Backport of !4037 - - - - - 36fc0a06 by Ben Gamari at 2020-09-17T14:50:46-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory (cherry picked from commit 9c6c1ebc9ab2f18d711a8793c7f0ec36e989d687) - - - - - 13 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Builders/RunTest.hs - libraries/Cabal - libraries/directory - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - testsuite/config/ghc - testsuite/driver/testglobals.py - testsuite/mk/test.mk 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:" ===================================== 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/Iface/Ext/Ast.hs ===================================== @@ -19,7 +19,7 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where +module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) ===================================== 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 ===================================== 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/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 1d886476c443b227bf93eba62781a6cad5012d9e +Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e ===================================== 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/f67f6d07a7ae2753c48e3c06378900f3fedf3f2c...36fc0a06c1dc9bd01e61ec6728aac954d347c3d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f67f6d07a7ae2753c48e3c06378900f3fedf3f2c...36fc0a06c1dc9bd01e61ec6728aac954d347c3d1 You're receiving 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 17 19:18:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 15:18:09 -0400 Subject: [Git][ghc/ghc][wip/backports] 23 commits: Don't mark closed type family equations as occurrences Message-ID: <5f63b671a6316_80bede0d60127524fd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 3667e26f by Ryan Scott at 2020-09-17T14:59:42-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. (cherry picked from commit 4f83e9ad76b1e7c67a440ea89f22f6fc03921b5d) - - - - - 58afde89 by Ryan Scott at 2020-09-17T15:00:14-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. (cherry picked from commit 502605f7ae9907a6b0b9823e8f055ae390c57b1d) - - - - - 5f039752 by Ben Gamari at 2020-09-17T15:04:37-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. (cherry picked from commit 708e374a8bf108999c11b6cf59c7d27677ed24a8) - - - - - 30a01228 by Ben Gamari at 2020-09-17T15:04:41-04:00 testsuite: Add test for #18118 (cherry picked from commit 2cdb72a569f6049a390626bca0dd6e362045ed65) - - - - - 034e7d05 by Ben Gamari at 2020-09-17T15:05:05-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. (cherry picked from commit 77b1ebf6dd34df8068a07865d92301ff298cf5ca) - - - - - 9b786e0e by Ben Gamari at 2020-09-17T15:05:19-04:00 llvm-targets: Add i686 targets Addresses #18422. (cherry picked from commit 12dadd04a09c23c91d7da6f5b17ef78688d93fe7) - - - - - 73f42f00 by Krzysztof Gogolewski at 2020-09-17T15:08:59-04: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'. (cherry picked from commit 8b86509270227dbc61f0700c7d9261a4c7672361) - - - - - 237d440a by Krzysztof Gogolewski at 2020-09-17T15:09:22-04:00 Move pprTyTcApp' inside pprTyTcApp No semantic change (cherry picked from commit d8f61182c3bdd1b6121c83be632b4941b907de88) - - - - - b4d761ee by Moritz Angermann at 2020-09-17T15:11:42-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 (cherry picked from commit d99397a0e8e0ce78e98efae67ee1ba2524ca16d6) - - - - - d3e0b905 by Takenobu Tani at 2020-09-17T15:12:57-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. (cherry picked from commit 84ec8daa016d07ae42f0f0f48575dd7d907d5f9d) - - - - - 3221a451 by Ben Gamari at 2020-09-17T15:14:34-04:00 configure: Fix whitespace (cherry picked from commit 1213fd87564ab092aa914d8633df4de07fe04905) - - - - - 8f3a8706 by Ben Gamari at 2020-09-17T15:14:58-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. (cherry picked from commit 566ac68de70e5b580c96e8ab8b3b02ad0f1acd42) - - - - - b640cdf1 by Ben Gamari at 2020-09-17T15:15:07-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. (cherry picked from commit 72036e1c03385aa4f5ed70179ab4b154beed81cb) - - - - - ba6fb181 by Ben Gamari at 2020-09-17T15:15:20-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. (cherry picked from commit 4597752ad3c031e17fe3cceb20c61e4d5b58c52f) - - - - - 4748afdc by Ben Gamari at 2020-09-17T15:15:24-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. (cherry picked from commit 5b12bb7c98529374ff8e932d0c36104d1a0fe509) - - - - - 51dcc6e2 by Ben Gamari at 2020-09-17T15:15:29-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. (cherry picked from commit c4fd8947f4104e7b6d6bf3d320a63a361191bde1) - - - - - 42b8dabd by Ben Gamari at 2020-09-17T15:15:46-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. (cherry picked from commit c2fefaf37ae134aefc4136bae7e5976f991d76f4) - - - - - c908eac6 by Ryan Scott at 2020-09-17T15:15:55-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. (cherry picked from commit 5e883375409efc2336da6295c7d81bd10b542210) - - - - - 25743d99 by Ryan Scott at 2020-09-17T15:16:22-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. (cherry picked from commit bc487caf830ce6cd2c03845b29416c6706185fbc) - - - - - ddd3a41e by Krzysztof Gogolewski at 2020-09-17T15:16:26-04:00 Make sure we can read past perf notes See #18656. (cherry picked from commit b8a9cff2ce651c085c84980d3e709db2ecda8c3f) - - - - - 156e23ee by Ben Gamari at 2020-09-17T15:16:53-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. (cherry picked from commit 35ea92708e17c90e476167163ae24747a3f5508e) - - - - - d01482b7 by HaskellMouse at 2020-09-17T15:17:27-04:00 Added explicit fixity to (~). Solves #18252 (cherry picked from commit 3c94c81629ac9159775b8b70baf2c635f0331708) - - - - - d6440d5c by Ben Gamari at 2020-09-17T15:17:52-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. (cherry picked from commit a64e94f98ca18e53ecc13f736d50b9cb2d156b05) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Utils/Outputable.hs - hadrian/hadrian.cabal - hadrian/src/Settings/Builders/RunTest.hs - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - llvm-targets - rts/RtsMessages.c - rts/RtsSymbols.c - rts/STM.c - rts/linker/Elf.c - testsuite/driver/perf_notes.py - testsuite/mk/test.mk The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36fc0a06c1dc9bd01e61ec6728aac954d347c3d1...d6440d5ce59d6d95c00dcc50599d91f14018e6f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36fc0a06c1dc9bd01e61ec6728aac954d347c3d1...d6440d5ce59d6d95c00dcc50599d91f14018e6f5 You're receiving 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 17 19:20:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 15:20:40 -0400 Subject: [Git][ghc/ghc][wip/backports] gitlab-ci: Use hadrian builds for Windows release artifacts Message-ID: <5f63b7083c6af_80b3f849a1b9eec12752831@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 71fa1a16 by Ben Gamari at 2020-09-17T15:20:33-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts (cherry picked from commit d4bc9f0de7992f60bce403731019829f6248cc2c) - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -826,13 +826,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 @@ -873,13 +876,14 @@ 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-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release extends: .build-x86_64-windows-hadrian View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71fa1a167ab0fe7ec8a4ec6d0e16b37d63719198 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71fa1a167ab0fe7ec8a4ec6d0e16b37d63719198 You're receiving 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 17 19:34:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 15:34:04 -0400 Subject: [Git][ghc/ghc][wip/backports-8.10] 4 commits: rts linker: teach the linker about GLIBC's special handling of *stat, mknod... Message-ID: <5f63ba2c437d7_80b10fabe9012753282@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 721dc35d by Adam Sandberg Ericsson at 2020-09-12T10:19:57+01:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 (cherry picked from commit 0effc57d48ace6b719a9f4cbeac67c95ad55010b) - - - - - ba74b527 by Ben Gamari at 2020-09-17T15:33:35-04:00 Bump text submodule to 1.2.4.0+ Fixes #18588 and #17956. - - - - - ab9debd5 by Ömer Sinan Ağacan at 2020-09-17T15:33:35-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 (cherry picked from commit 08c1cb0f30770acbf366423f085f8ef92f7f6a06) - - - - - dbe36f62 by GHC GitLab CI at 2020-09-17T15:33:35-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) - - - - - 14 changed files: - aclocal.m4 - compiler/main/SysTools/Settings.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - libraries/text - mk/config.mk.in - rts/Linker.c - rules/build-package-way.mk - testsuite/tests/rts/linker/Makefile - + testsuite/tests/rts/linker/T7072-main.c - + testsuite/tests/rts/linker/T7072-obj.c - + testsuite/tests/rts/linker/T7072.stderr - testsuite/tests/rts/linker/all.T 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) @@ -2589,7 +2599,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]) @@ -2609,33 +2619,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/main/SysTools/Settings.hs ===================================== @@ -141,7 +141,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 ===================================== @@ -429,6 +429,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@ @@ -114,10 +115,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 ===================================== @@ -313,7 +313,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/text ===================================== @@ -1 +1 @@ -Subproject commit c6768a2a07e94b8b26d0f0e53517773de1110ce2 +Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade ===================================== mk/config.mk.in ===================================== @@ -556,6 +556,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.c ===================================== @@ -655,23 +655,51 @@ internal_dlsym(const char *symbol) { // We acquire dl_mutex as concurrent dl* calls may alter dlerror ACQUIRE_LOCK(&dl_mutex); + + // clears dlerror dlerror(); + // look in program first v = dlsym(dl_prog_handle, symbol); if (dlerror() == NULL) { RELEASE_LOCK(&dl_mutex); + IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in program\n", symbol)); return v; } for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) { v = dlsym(o_so->handle, symbol); if (dlerror() == NULL) { + IF_DEBUG(linker, debugBelch("internal_dlsym: found symbol '%s' in shared object\n", symbol)); RELEASE_LOCK(&dl_mutex); return v; } } RELEASE_LOCK(&dl_mutex); - return v; + +# if defined(HAVE_SYS_STAT_H) && defined(linux_HOST_OS) && defined(__GLIBC__) + // HACK: GLIBC implements these functions with a great deal of trickery where + // they are either inlined at compile time to their corresponding + // __xxxx(SYS_VER, ...) function or direct syscalls, or resolved at + // link time via libc_nonshared.a. + // + // We borrow the approach that the LLVM JIT uses to resolve these + // symbols. See http://llvm.org/PR274 and #7072 for more info. + + IF_DEBUG(linker, debugBelch("internal_dlsym: looking for symbol '%s' in GLIBC special cases\n", symbol)); + + if (strcmp(symbol, "stat") == 0) return (void*)&stat; + if (strcmp(symbol, "fstat") == 0) return (void*)&fstat; + if (strcmp(symbol, "lstat") == 0) return (void*)&lstat; + if (strcmp(symbol, "stat64") == 0) return (void*)&stat64; + if (strcmp(symbol, "fstat64") == 0) return (void*)&fstat64; + if (strcmp(symbol, "lstat64") == 0) return (void*)&lstat64; + if (strcmp(symbol, "atexit") == 0) return (void*)&atexit; + if (strcmp(symbol, "mknod") == 0) return (void*)&mknod; +# endif + + // we failed to find the symbol + return NULL; } # endif @@ -847,13 +875,13 @@ SymbolAddr* lookupSymbol_ (SymbolName* lbl) SymbolAddr* lookupSymbol_ (SymbolName* lbl) { - IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl)); + IF_DEBUG(linker, debugBelch("lookupSymbol: looking up '%s'\n", lbl)); ASSERT(symhash != NULL); RtsSymbolInfo *pinfo; if (!ghciLookupSymbolInfo(symhash, lbl, &pinfo)) { - IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n")); + IF_DEBUG(linker, debugBelch("lookupSymbol: symbol '%s' not found, trying dlsym\n", lbl)); # if defined(OBJFORMAT_ELF) return internal_dlsym(lbl); @@ -1343,23 +1371,6 @@ void freeObjectCode (ObjectCode *oc) stgFree(oc); } -/* ----------------------------------------------------------------------------- -* Sets the initial status of a fresh ObjectCode -*/ -static void setOcInitialStatus(ObjectCode* oc) { - /* If a target has requested the ObjectCode not to be resolved then - honor this requests. Usually this means the ObjectCode has not been - initialized and can't be. */ - if (oc->status == OBJECT_DONT_RESOLVE) - return; - - if (oc->archiveMemberName == NULL) { - oc->status = OBJECT_NEEDED; - } else { - oc->status = OBJECT_LOADED; - } -} - ObjectCode* mkOc( pathchar *path, char *image, int imageSize, bool mapped, char *archiveMemberName, int misalignment ) { @@ -1392,7 +1403,11 @@ mkOc( pathchar *path, char *image, int imageSize, oc->archiveMemberName = NULL; } - setOcInitialStatus( oc ); + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } oc->fileSize = imageSize; oc->symbols = NULL; @@ -1683,8 +1698,17 @@ HsInt loadOc (ObjectCode* oc) # endif #endif - /* loaded, but not resolved yet, ensure the OC is in a consistent state */ - setOcInitialStatus( oc ); + /* Loaded, but not resolved yet, ensure the OC is in a consistent state. + If a target has requested the ObjectCode not to be resolved then honor + this requests. Usually this means the ObjectCode has not been initialized + and can't be. */ + if (oc->status != OBJECT_DONT_RESOLVE) { + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } + } IF_DEBUG(linker, debugBelch("loadOc: done.\n")); return 1; ===================================== 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/rts/linker/Makefile ===================================== @@ -96,3 +96,10 @@ linker_error3: "$(TEST_HC)" -c linker_error3.c -o linker_error3_o.o "$(TEST_HC)" linker_error3.o -o linker_error3 -no-hs-main -optc-g -debug -threaded ./linker_error3 linker_error3_o.o + +.PHONY: T7072 +T7072: + "$(TEST_HC)" -c T7072-obj.c -o T7072-obj.o + "$(TEST_HC)" -c T7072-main.c -o T7072-main.o + "$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug + ./T7072-main T7072-obj.o ===================================== testsuite/tests/rts/linker/T7072-main.c ===================================== @@ -0,0 +1,39 @@ +#include "ghcconfig.h" +#include "Rts.h" +#include +#include + +int main (int argc, char *argv[]) +{ + int r; + char *obj; + + hs_init(&argc, &argv); + + initLinker_(0); + + // Load object file argv[1] repeatedly + + if (argc != 2) { + errorBelch("usage: T7072-main "); + exit(1); + } + + obj = argv[1]; + + r = loadObj(obj); + if (!r) { + debugBelch("loadObj(%s) failed\n", obj); + exit(1); + } + r = resolveObjs(); + if (!r) { + debugBelch("resolveObjs failed\n"); + unloadObj(obj); + exit(1); + } + debugBelch("loading succeeded"); + + hs_exit(); + return 0; +} ===================================== testsuite/tests/rts/linker/T7072-obj.c ===================================== @@ -0,0 +1,17 @@ +#include +#include +#include +#include + +typedef int stat_func(const char*, struct stat*); + +stat_func *foo = &stat; + +void stat_test(void) +{ + struct stat buf; + + printf("About to stat-test.c\n"); + foo("stat-test.c", &buf); + printf("Done\n"); +} ===================================== testsuite/tests/rts/linker/T7072.stderr ===================================== @@ -0,0 +1 @@ +loading succeeded \ No newline at end of file ===================================== testsuite/tests/rts/linker/all.T ===================================== @@ -92,3 +92,10 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) , omit_ways(['ghci']) ], compile_and_run, ['-rdynamic -package ghc']) + + +test('T7072', + [extra_files(['T7072-main.c', 'T7072-obj.c']), + unless(opsys('linux'), skip), + req_rts_linker], + makefile_test, ['T7072']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd2af2c6a4f21d233499c33fb71d029ed0c1e4f3...dbe36f62e27f61fd4e1bb99ce8bf71783bd713da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd2af2c6a4f21d233499c33fb71d029ed0c1e4f3...dbe36f62e27f61fd4e1bb99ce8bf71783bd713da You're receiving 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 17 19:35:29 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 15:35:29 -0400 Subject: [Git][ghc/ghc][wip/backports] 15 commits: Limit upper version of Happy for ghc-9.0 and earlier (#18620) Message-ID: <5f63ba819f1d4_80b10fabe901275378b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 8a8796b9 by Takenobu Tani at 2020-09-17T15:35:22-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. (cherry picked from commit 84ec8daa016d07ae42f0f0f48575dd7d907d5f9d) - - - - - 92a45b51 by Ben Gamari at 2020-09-17T15:35:22-04:00 configure: Fix whitespace (cherry picked from commit 1213fd87564ab092aa914d8633df4de07fe04905) - - - - - 3b708111 by Ben Gamari at 2020-09-17T15:35:22-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. (cherry picked from commit 566ac68de70e5b580c96e8ab8b3b02ad0f1acd42) - - - - - 2ab52f12 by Ben Gamari at 2020-09-17T15:35:22-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. (cherry picked from commit 72036e1c03385aa4f5ed70179ab4b154beed81cb) - - - - - 3e7c5c7e by Ben Gamari at 2020-09-17T15:35:22-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. (cherry picked from commit 4597752ad3c031e17fe3cceb20c61e4d5b58c52f) - - - - - d02d59af by Ben Gamari at 2020-09-17T15:35:22-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. (cherry picked from commit 5b12bb7c98529374ff8e932d0c36104d1a0fe509) - - - - - 863ccedd by Ben Gamari at 2020-09-17T15:35:22-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. (cherry picked from commit c4fd8947f4104e7b6d6bf3d320a63a361191bde1) - - - - - e8a31cbb by Ben Gamari at 2020-09-17T15:35:22-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. (cherry picked from commit c2fefaf37ae134aefc4136bae7e5976f991d76f4) - - - - - c2dbcacb by Ryan Scott at 2020-09-17T15:35:22-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. (cherry picked from commit 5e883375409efc2336da6295c7d81bd10b542210) - - - - - 8048568d by Ryan Scott at 2020-09-17T15:35:22-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. (cherry picked from commit bc487caf830ce6cd2c03845b29416c6706185fbc) - - - - - c6215eb1 by Krzysztof Gogolewski at 2020-09-17T15:35:22-04:00 Make sure we can read past perf notes See #18656. (cherry picked from commit b8a9cff2ce651c085c84980d3e709db2ecda8c3f) - - - - - 24120575 by Ben Gamari at 2020-09-17T15:35:22-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. (cherry picked from commit 35ea92708e17c90e476167163ae24747a3f5508e) - - - - - 7fcac7c7 by HaskellMouse at 2020-09-17T15:35:22-04:00 Added explicit fixity to (~). Solves #18252 (cherry picked from commit 3c94c81629ac9159775b8b70baf2c635f0331708) - - - - - b8a5b416 by Ben Gamari at 2020-09-17T15:35:22-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. (cherry picked from commit a64e94f98ca18e53ecc13f736d50b9cb2d156b05) - - - - - 379921d6 by Ben Gamari at 2020-09-17T15:35:22-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts (cherry picked from commit d4bc9f0de7992f60bce403731019829f6248cc2c) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/GHC/Core/Class.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - hadrian/hadrian.cabal - hadrian/src/Settings/Builders/RunTest.hs - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - rts/RtsMessages.c - rts/RtsSymbols.c - rts/STM.c - testsuite/driver/perf_notes.py - − testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/T18060/T18060.stdout - testsuite/tests/ghci/scripts/T10059.stdout - testsuite/tests/ghci/scripts/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/71fa1a167ab0fe7ec8a4ec6d0e16b37d63719198...379921d61f4cbd78d00bb885714715b5c43d7fe8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71fa1a167ab0fe7ec8a4ec6d0e16b37d63719198...379921d61f4cbd78d00bb885714715b5c43d7fe8 You're receiving 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 17 22:09:59 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 18:09:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18698 Message-ID: <5f63deb757cde_80b3f8486227c94127851cd@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T18698 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18698 You're receiving 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 17 22:45:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 18:45:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17905 Message-ID: <5f63e721f4101_80babb01201278876@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T17905 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17905 You're receiving 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 17 22:46:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 18:46:26 -0400 Subject: [Git][ghc/ghc][wip/T17905] rts: Drop field initializer on thread_basic_info_data_t Message-ID: <5f63e742e7cd_80beccaf5c127889bc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T17905 at Glasgow Haskell Compiler / GHC Commits: 09b91e8b by Ben Gamari at 2020-09-17T18:46:19-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 1 changed file: - rts/posix/GetTime.c Changes: ===================================== rts/posix/GetTime.c ===================================== @@ -71,7 +71,7 @@ Time getCurrentThreadCPUTime(void) // support clock_getcpuclockid. Hence we prefer to use the Darwin-specific // path on Darwin, even if clock_gettime is available. #if defined(darwin_HOST_OS) - thread_basic_info_data_t info = { 0 }; + thread_basic_info_data_t info = { }; mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT; kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO, (thread_info_t) &info, &info_count); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09b91e8b95eb16fe72aef8405896fd6caf789f61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09b91e8b95eb16fe72aef8405896fd6caf789f61 You're receiving 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 17 23:46:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 19:46:44 -0400 Subject: [Git][ghc/ghc][wip/backports] 24 commits: Bump Win32 submodule to 2.9.0.0 Message-ID: <5f63f56447773_80b3f841422ef8412803023@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 59862b4a by Ben Gamari at 2020-09-17T19:46:29-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory (cherry picked from commit 9c6c1ebc9ab2f18d711a8793c7f0ec36e989d687) - - - - - e8f5e16a by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 4f83e9ad76b1e7c67a440ea89f22f6fc03921b5d) - - - - - eae6f239 by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 502605f7ae9907a6b0b9823e8f055ae390c57b1d) - - - - - 8dcbbeec by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 708e374a8bf108999c11b6cf59c7d27677ed24a8) - - - - - df6d0218 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Add test for #18118 (cherry picked from commit 2cdb72a569f6049a390626bca0dd6e362045ed65) - - - - - 675c0cce by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 77b1ebf6dd34df8068a07865d92301ff298cf5ca) - - - - - 7e315b15 by Ben Gamari at 2020-09-17T19:46:29-04:00 llvm-targets: Add i686 targets Addresses #18422. (cherry picked from commit 12dadd04a09c23c91d7da6f5b17ef78688d93fe7) - - - - - 264afed3 by Krzysztof Gogolewski at 2020-09-17T19:46:29-04: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'. (cherry picked from commit 8b86509270227dbc61f0700c7d9261a4c7672361) - - - - - 2c2ed25b by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Move pprTyTcApp' inside pprTyTcApp No semantic change (cherry picked from commit d8f61182c3bdd1b6121c83be632b4941b907de88) - - - - - 8d0a75c6 by Takenobu Tani at 2020-09-17T19:46:29-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. (cherry picked from commit 84ec8daa016d07ae42f0f0f48575dd7d907d5f9d) - - - - - aac5417a by Ben Gamari at 2020-09-17T19:46:29-04:00 configure: Fix whitespace (cherry picked from commit 1213fd87564ab092aa914d8633df4de07fe04905) - - - - - b83682c7 by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. (cherry picked from commit 566ac68de70e5b580c96e8ab8b3b02ad0f1acd42) - - - - - cb8610b8 by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 72036e1c03385aa4f5ed70179ab4b154beed81cb) - - - - - ab244fc9 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. (cherry picked from commit 4597752ad3c031e17fe3cceb20c61e4d5b58c52f) - - - - - ad6cef78 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. (cherry picked from commit 5b12bb7c98529374ff8e932d0c36104d1a0fe509) - - - - - cc3e00cb by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. (cherry picked from commit c4fd8947f4104e7b6d6bf3d320a63a361191bde1) - - - - - 702bd58c by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. (cherry picked from commit c2fefaf37ae134aefc4136bae7e5976f991d76f4) - - - - - 5b0fb69f by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 5e883375409efc2336da6295c7d81bd10b542210) - - - - - 7d00408b by Ryan Scott at 2020-09-17T19:46:29-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. (cherry picked from commit bc487caf830ce6cd2c03845b29416c6706185fbc) - - - - - 8edda01f by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Make sure we can read past perf notes See #18656. (cherry picked from commit b8a9cff2ce651c085c84980d3e709db2ecda8c3f) - - - - - af32a4cb by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. (cherry picked from commit 35ea92708e17c90e476167163ae24747a3f5508e) - - - - - efc41fcc by HaskellMouse at 2020-09-17T19:46:29-04:00 Added explicit fixity to (~). Solves #18252 (cherry picked from commit 3c94c81629ac9159775b8b70baf2c635f0331708) - - - - - 3309d2a2 by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit a64e94f98ca18e53ecc13f736d50b9cb2d156b05) - - - - - 4e00ee7b by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts (cherry picked from commit d4bc9f0de7992f60bce403731019829f6248cc2c) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/hadrian.cabal - hadrian/src/Settings/Builders/RunTest.hs - libraries/Cabal - libraries/directory - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - llvm-targets - rts/RtsMessages.c - rts/RtsSymbols.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379921d61f4cbd78d00bb885714715b5c43d7fe8...4e00ee7b9c1da4ee687673309a154c9718437473 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/379921d61f4cbd78d00bb885714715b5c43d7fe8...4e00ee7b9c1da4ee687673309a154c9718437473 You're receiving 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 17 23:48:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 19:48:49 -0400 Subject: [Git][ghc/ghc][wip/tsan/storage] squash: Accept races Message-ID: <5f63f5e1fca9_80b3f8428d94ab8128034bd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tsan/storage at Glasgow Haskell Compiler / GHC Commits: a5c4e8d5 by Ben Gamari at 2020-09-17T19:48:42-04:00 squash: Accept races - - - - - 1 changed file: - rts/sm/Storage.c Changes: ===================================== rts/sm/Storage.c ===================================== @@ -1565,6 +1565,7 @@ calcNeeded (bool force_major, memcount *blocks_needed) // This can race with allocate() and compactAllocateBlockInternal() // but only needs to be approximate + TSAN_ANNOTATE_BENIGN_RACE(&gen->n_large_blocks, "n_large_blocks"); blocks += RELAXED_LOAD(&gen->n_large_blocks) + RELAXED_LOAD(&gen->n_compact_blocks); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5c4e8d5d61d4eff379bf780966c251b779217ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5c4e8d5d61d4eff379bf780966c251b779217ac You're receiving 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 17 23:52:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 19:52:44 -0400 Subject: [Git][ghc/ghc][wip/bump-version] 46 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f63f6cc3c40c_80b3f84290d52e01280529e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-version 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - 16cc81cc by Ben Gamari at 2020-09-17T19:51:26-04:00 Bump version to 9.1 - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - README.md - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.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/c91e00482fae0f89eb35a00a2b565aa73c9292bc...16cc81cc92932eb0ada3c4a7c553bd60af253357 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c91e00482fae0f89eb35a00a2b565aa73c9292bc...16cc81cc92932eb0ada3c4a7c553bd60af253357 You're receiving 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 17 23:55:15 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 19:55:15 -0400 Subject: [Git][ghc/ghc][wip/docs-fixes] hadrian: Fail on Sphinx syntax errors Message-ID: <5f63f76351f4f_80b3f84296d07581280758e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/docs-fixes at Glasgow Haskell Compiler / GHC Commits: 28d058ad by Ben Gamari at 2020-09-17T19:55:05-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - 1 changed file: - hadrian/src/Rules/Documentation.hs Changes: ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -127,6 +127,21 @@ checkSphinxWarnings :: FilePath -- ^ output directory -> Action () checkSphinxWarnings out = do log <- liftIO $ readFile (out -/- ".log") + when ("Inline literal start-string without end-string." `isInfixOf` log) + $ fail $ unlines + [ "Syntax error found in Sphinx log. " + , "" + , "This likely means that you have forgotten a \\ after inline code block. For instance," + , "you might have written:" + , "" + , " are not allowed to contain nested ``forall``s." + , "" + , "Whereas you need to write:" + , "" + , " are not allowed to contain nested ``forall``\\s." + , "" + ] + when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d058ad707c686e21609579e0be8a012748161c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28d058ad707c686e21609579e0be8a012748161c You're receiving 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 17 23:57:59 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 19:57:59 -0400 Subject: [Git][ghc/ghc][wip/perf-ci] 152 commits: Add HomeUnit type Message-ID: <5f63f807ba4e3_80b3f8468b8ac6412808272@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/perf-ci 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 - - - - - 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - 841c2b7c by Ben Gamari at 2020-09-17T19:57:43-04:00 ci.sh: Factor out common utilities - - - - - 8ff42bbe by Ben Gamari at 2020-09-17T19:57:43-04:00 ci: Add ad-hoc performance testing rule - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - README.md - 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.hs - compiler/GHC/Cmm/CLabel.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/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43bda605b34f7302e68f4d6455ac84a118679fe5...8ff42bbe2136b12e6d4f5b347e65affd51aaf021 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43bda605b34f7302e68f4d6455ac84a118679fe5...8ff42bbe2136b12e6d4f5b347e65affd51aaf021 You're receiving 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 18 00:04:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 20:04:13 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Introduce OutputableP Message-ID: <5f63f97da8953_80bed3994812810937@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - 30 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9dec8600ad4734607bea2b4dc3b40a5af788996b...7f2785f2d6c6947d22d4d8b71d205c7c4b025680 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9dec8600ad4734607bea2b4dc3b40a5af788996b...7f2785f2d6c6947d22d4d8b71d205c7c4b025680 You're receiving 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 18 00:04:52 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 20:04:52 -0400 Subject: [Git][ghc/ghc][master] Bignum: add clamping naturalToWord (fix #18697) Message-ID: <5f63f9a4ed07d_80b3f84460ad05c128157d1@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 1 changed file: - libraries/ghc-bignum/src/GHC/Num/Natural.hs Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -107,6 +107,14 @@ naturalToWord# (NB b) = bigNatIndex# b 0# naturalToWord :: Natural -> Word naturalToWord !n = W# (naturalToWord# n) +-- | Convert a Natural into a Word# clamping to (maxBound :: Word#). +naturalToWordClamp# :: Natural -> Word# +naturalToWordClamp# (NS x) = x +naturalToWordClamp# (NB _) = WORD_MAXBOUND## + +-- | Convert a Natural into a Word# clamping to (maxBound :: Word). +naturalToWordClamp :: Natural -> Word +naturalToWordClamp !n = W# (naturalToWordClamp# n) -- | Try downcasting 'Natural' to 'Word' value. -- Returns '()' if value doesn't fit in 'Word'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b689f3db0229ac58af5383796fb13c6d40e358ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b689f3db0229ac58af5383796fb13c6d40e358ce You're receiving 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 18 00:06:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 17 Sep 2020 20:06:48 -0400 Subject: [Git][ghc/ghc][wip/T18566] Unstaged changes Message-ID: <5f63fa18beaa1_80b3f83f38c23bc12815926@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18566 at Glasgow Haskell Compiler / GHC Commits: d1d2305d by GHC GitLab CI at 2020-09-18T00:06:33+00:00 Unstaged changes - - - - - 3 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Core/Opt/CallerCC.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE TupleSections #-} +-- | Adds cost-centers to call sites selected with the -fprof-caller=... flag. module GHC.Core.Opt.CallerCC ( addCallerCostCentres , CallerCcFilter @@ -13,14 +14,12 @@ module GHC.Core.Opt.CallerCC ) where import Data.Bifunctor -import Data.Data +import Data.Word (Word8) import Data.Maybe import qualified Text.Parsec as P import Control.Applicative import Control.Monad.Trans.State.Strict -import qualified Data.ByteString.Lazy as BSL -import Data.List (intercalate) import Data.Either import Control.Monad @@ -37,11 +36,10 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Unit.Types import GHC.Data.FastString -import GHC.Types.Id.Info import GHC.Core import GHC.Core.Opt.Monad - -import GHC.Prelude +import GHC.Utils.Panic +import qualified GHC.Utils.Binary as B addCallerCostCentres :: ModGuts -> CoreM ModGuts addCallerCostCentres guts = do @@ -73,7 +71,7 @@ doExpr :: Env -> CoreExpr -> M CoreExpr doExpr env e@(Var v) | needsCallSiteCostCentre env v = do let nameDoc :: SDoc - nameDoc = fcat (punctuate dot (map ppr (parents env))) <> parens (text "calling " <> ppr v) + nameDoc = hcat (punctuate dot (map ppr (parents env))) <> parens (text "calling " <> ppr v) ccName :: CcName ccName = mkFastString $ showSDoc (dflags env) nameDoc @@ -86,7 +84,7 @@ doExpr env e@(Var v) tick = ProfNote cc True True pure $ Tick tick e | otherwise = pure e -doExpr env e@(Lit _) = pure e +doExpr _env e@(Lit _) = pure e doExpr env (f `App` x) = App <$> doExpr env f <*> doExpr env x doExpr env (Lam b x) = Lam b <$> doExpr env x doExpr env (Let b rhs) = Let <$> doBind env b <*> doExpr env rhs @@ -96,8 +94,8 @@ doExpr env (Case scrut b ty alts) = doAlt (con, bs, rhs) = (con, bs,) <$> doExpr env rhs doExpr env (Cast expr co) = Cast <$> doExpr env expr <*> pure co doExpr env (Tick t e) = Tick t <$> doExpr env e -doExpr env e@(Type _) = pure e -doExpr env e@(Coercion _) = pure e +doExpr _env e@(Type _) = pure e +doExpr _env e@(Coercion _) = pure e type M = State CostCentreState @@ -148,6 +146,18 @@ instance Outputable NamePattern where ppr (PWildcard rest) = char '*' <> ppr rest ppr PEnd = Outputable.empty +instance B.Binary NamePattern where + get bh = do + tag <- B.get bh + case tag :: Word8 of + 0 -> PChar <$> B.get bh <*> B.get bh + 1 -> PWildcard <$> B.get bh + 2 -> pure PEnd + _ -> panic "Binary(NamePattern): Invalid tag" + put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y + put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x + put_ bh PEnd = B.put_ bh (2 :: Word8) + occNameMatches :: NamePattern -> OccName -> Bool occNameMatches pat = go pat . occNameString where @@ -181,6 +191,10 @@ instance Outputable CallerCcFilter where <> char '.' <> ppr (ccfFuncName ccf) +instance B.Binary CallerCcFilter where + get bh = CallerCcFilter <$> B.get bh <*> B.get bh + put_ bh (CallerCcFilter x y) = B.put_ bh x >> B.put_ bh y + parseCallerCcFilter :: String -> Either String CallerCcFilter parseCallerCcFilter = first show . P.parse parseCallerCcFilter' "caller-CC filter" ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -17,6 +17,7 @@ import GHC.Unit.Module import GHC.Types.Name import GHC.Utils.Fingerprint import GHC.Iface.Recomp.Binary +import GHC.Core.Opt.CallerCC () -- for Binary instances -- import GHC.Utils.Outputable import GHC.Data.EnumSet as EnumSet ===================================== compiler/ghc.cabal.in ===================================== @@ -71,6 +71,7 @@ Library hpc == 0.6.*, transformers == 0.5.*, exceptions == 0.10.*, + parsec, ghc-boot == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1d2305d670e7f3befb849167fca22f91f5105a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1d2305d670e7f3befb849167fca22f91f5105a2 You're receiving 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 18 00:35:39 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 17 Sep 2020 20:35:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Introduce OutputableP Message-ID: <5f6400db524cf_80b3f8494c8c154128212f0@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - bddc268a by Ben Gamari at 2020-09-17T20:35:32-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. - - - - - 40ab5ee1 by Ben Gamari at 2020-09-17T20:35:33-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. - - - - - 6fa917e0 by Ben Gamari at 2020-09-17T20:35:33-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. - - - - - 30 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd73fa40bf83d4f37b69f1bcda30152a84413aa1...6fa917e05113518b24225c3ef85205be22c4b005 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd73fa40bf83d4f37b69f1bcda30152a84413aa1...6fa917e05113518b24225c3ef85205be22c4b005 You're receiving 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 18 11:08:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 07:08:52 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f64954423f13_80b3f848bc0cbec1295345@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 18 11:08:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 07:08:52 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 24 commits: Bump Win32 submodule to 2.9.0.0 Message-ID: <5f649544c10f3_80b3f8434f88160129536c7@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 59862b4a by Ben Gamari at 2020-09-17T19:46:29-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory (cherry picked from commit 9c6c1ebc9ab2f18d711a8793c7f0ec36e989d687) - - - - - e8f5e16a by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 4f83e9ad76b1e7c67a440ea89f22f6fc03921b5d) - - - - - eae6f239 by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 502605f7ae9907a6b0b9823e8f055ae390c57b1d) - - - - - 8dcbbeec by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 708e374a8bf108999c11b6cf59c7d27677ed24a8) - - - - - df6d0218 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Add test for #18118 (cherry picked from commit 2cdb72a569f6049a390626bca0dd6e362045ed65) - - - - - 675c0cce by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 77b1ebf6dd34df8068a07865d92301ff298cf5ca) - - - - - 7e315b15 by Ben Gamari at 2020-09-17T19:46:29-04:00 llvm-targets: Add i686 targets Addresses #18422. (cherry picked from commit 12dadd04a09c23c91d7da6f5b17ef78688d93fe7) - - - - - 264afed3 by Krzysztof Gogolewski at 2020-09-17T19:46:29-04: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'. (cherry picked from commit 8b86509270227dbc61f0700c7d9261a4c7672361) - - - - - 2c2ed25b by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Move pprTyTcApp' inside pprTyTcApp No semantic change (cherry picked from commit d8f61182c3bdd1b6121c83be632b4941b907de88) - - - - - 8d0a75c6 by Takenobu Tani at 2020-09-17T19:46:29-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. (cherry picked from commit 84ec8daa016d07ae42f0f0f48575dd7d907d5f9d) - - - - - aac5417a by Ben Gamari at 2020-09-17T19:46:29-04:00 configure: Fix whitespace (cherry picked from commit 1213fd87564ab092aa914d8633df4de07fe04905) - - - - - b83682c7 by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. (cherry picked from commit 566ac68de70e5b580c96e8ab8b3b02ad0f1acd42) - - - - - cb8610b8 by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit 72036e1c03385aa4f5ed70179ab4b154beed81cb) - - - - - ab244fc9 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. (cherry picked from commit 4597752ad3c031e17fe3cceb20c61e4d5b58c52f) - - - - - ad6cef78 by Ben Gamari at 2020-09-17T19:46:29-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. (cherry picked from commit 5b12bb7c98529374ff8e932d0c36104d1a0fe509) - - - - - cc3e00cb by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. (cherry picked from commit c4fd8947f4104e7b6d6bf3d320a63a361191bde1) - - - - - 702bd58c by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. (cherry picked from commit c2fefaf37ae134aefc4136bae7e5976f991d76f4) - - - - - 5b0fb69f by Ryan Scott at 2020-09-17T19:46:29-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. (cherry picked from commit 5e883375409efc2336da6295c7d81bd10b542210) - - - - - 7d00408b by Ryan Scott at 2020-09-17T19:46:29-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. (cherry picked from commit bc487caf830ce6cd2c03845b29416c6706185fbc) - - - - - 8edda01f by Krzysztof Gogolewski at 2020-09-17T19:46:29-04:00 Make sure we can read past perf notes See #18656. (cherry picked from commit b8a9cff2ce651c085c84980d3e709db2ecda8c3f) - - - - - af32a4cb by Ben Gamari at 2020-09-17T19:46:29-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. (cherry picked from commit 35ea92708e17c90e476167163ae24747a3f5508e) - - - - - efc41fcc by HaskellMouse at 2020-09-17T19:46:29-04:00 Added explicit fixity to (~). Solves #18252 (cherry picked from commit 3c94c81629ac9159775b8b70baf2c635f0331708) - - - - - 3309d2a2 by Ben Gamari at 2020-09-17T19:46:29-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. (cherry picked from commit a64e94f98ca18e53ecc13f736d50b9cb2d156b05) - - - - - 4e00ee7b by Ben Gamari at 2020-09-17T19:46:29-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts (cherry picked from commit d4bc9f0de7992f60bce403731019829f6248cc2c) - - - - - 30 changed files: - .gitlab-ci.yml - aclocal.m4 - compiler/GHC/Core/Class.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Utils/Outputable.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/hadrian.cabal - hadrian/src/Settings/Builders/RunTest.hs - libraries/Cabal - libraries/directory - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - llvm-targets - rts/RtsMessages.c - rts/RtsSymbols.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d9742c523ab3b69db9c98e4a113f7ed8bdf754...4e00ee7b9c1da4ee687673309a154c9718437473 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d9742c523ab3b69db9c98e4a113f7ed8bdf754...4e00ee7b9c1da4ee687673309a154c9718437473 You're receiving 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 18 12:01:59 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 18 Sep 2020 08:01:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-base-4.16 Message-ID: <5f64a1b76c44f_80b3f845590240012966835@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bump-base-4.16 You're receiving 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 18 12:16:33 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 18 Sep 2020 08:16:33 -0400 Subject: [Git][ghc/ghc][wip/bump-base-4.16] Version bump: base-4.16 (#18712) Message-ID: <5f64a5217fa5c_80b3f84157d53d812971136@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC Commits: e9066970 by Vladislav Zavialov at 2020-09-18T15:15:40+03:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 21 changed files: - compiler/ghc.cabal.in - libraries/array - libraries/base/base.cabal - libraries/base/changelog.md - libraries/deepseq - libraries/directory - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/unix - utils/haddock - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -57,7 +57,7 @@ Library Default-Language: Haskell2010 Exposed: False - Build-Depends: base >= 4.11 && < 4.16, + Build-Depends: base >= 4.11 && < 4.17, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, process >= 1 && < 1.7, ===================================== libraries/array ===================================== @@ -1 +1 @@ -Subproject commit ab535173d7885ebfc2005d8da2765f0f52c923ce +Subproject commit 10e6c7e0522367677e4c33cc1c56eb852ef13420 ===================================== libraries/base/base.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 3.0 name: base -version: 4.15.0.0 +version: 4.16.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.16.0.0 *TBA* + + ## 4.15.0.0 *TBA* * `openFile` now calls the `open` system call with an `interruptible` FFI @@ -18,7 +21,7 @@ `ConcFlags`, `DebugFlags`, `CCFlags`, `DoHeapProfile`, `ProfFlags`, `DoTrace`, `TraceFlags`, `TickyFlags`, `ParFlags`, `RTSFlags`, `RTSStats`, `GCStats`, `ByteOrder`, `GeneralCategory`, `SrcLoc` - + * Add rules `unpackUtf8`, `unpack-listUtf8` and `unpack-appendUtf8` to `GHC.Base`. They correspond to their ascii versions and hopefully make it easier for libraries to handle utf8 encoded strings efficiently. @@ -29,8 +32,8 @@ * Add `MonadFix` and `MonadZip` instances for `Complex` * Add `Ix` instances for tuples of size 6 through 15 - -## 4.14.0.0 *TBA* + +## 4.14.0.0 *Jan 2020* * Bundled with GHC 8.10.1 * Add a `TestEquality` instance for the `Compose` newtype. ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit 13c1c84415da727ab56e9fa33aca5046b6683848 +Subproject commit 0b0057a1c27da071c24f6b789d05661a7d5053db ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit 49d274dad953db62bc9a634f68cf1b0c5fcbb22c ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit 9088df9f97914664c9360857347d65c32dd6c892 +Subproject commit 5f33be2cf12d85ed1f01ab9303d54311373a006c ===================================== libraries/ghc-boot-th/ghc-boot-th.cabal.in ===================================== @@ -36,4 +36,4 @@ Library GHC.ForeignSrcLang.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.16 + build-depends: base >= 4.7 && < 4.17 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -62,7 +62,7 @@ Library -- GHC.Version -- GHC.Platform.Host - build-depends: base >= 4.7 && < 4.16, + build-depends: base >= 4.7 && < 4.17, binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -37,7 +37,7 @@ library CPP build-depends: ghc-prim >= 0.5.3 && < 0.8, - base >= 4.9.0 && < 4.16, + base >= 4.9.0 && < 4.17, bytestring >= 0.10.6.0 ghc-options: -Wall ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -72,7 +72,7 @@ library Build-Depends: array == 0.5.*, - base >= 4.8 && < 4.16, + base >= 4.8 && < 4.17, binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 2790f1c6ed94990ed51466079e8fb1097129c9b8 +Subproject commit 223b85218eb1d38acb9bcdb20ac72bc3ebbe1086 ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 772de3f7b43e31178f042ba77c071594845363e3 +Subproject commit fecf0496a65c4be275d613eb0632fecd5a123b69 ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 190492494fe92e8dd42165190b7ac112be1f7389 +Subproject commit 85096ee81af35283eae377893184df2a1240fdc5 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit a7f21f2f5b5d43450f852dfbc04a0b195fd7d834 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 444f672416a354c3cfde9d94ec237a36be46ef59 +Subproject commit 76de95bba1745bd6f09e86a326592779a1e36f72 ===================================== libraries/template-haskell/template-haskell.cabal.in ===================================== @@ -55,7 +55,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.11 && < 4.16, + base >= 4.11 && < 4.17, ghc-boot-th == @ProjectVersionMunged@, ghc-prim, pretty == 1.1.* ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 3ebb36f4a2c42b74ec4e35efccc2be34c198a830 +Subproject commit 5543be08b229936235e3974a8556c444a966b1f5 ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit ea13d990580273a883368793dfbb826cab5a22d4 +Subproject commit d513ff1ec058d6c862feac84e8ca645fa56184d4 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 2a15172bde75ec151a52fef586d1e362d478aae8 +Subproject commit 64229b808ca3a434e86a044aa8fa12649e63be28 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 53231a61f3387379f44864c4fd843059f1c7b77e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9066970e4944fb8b427b7de54aa7fa9df90495e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9066970e4944fb8b427b7de54aa7fa9df90495e You're receiving 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 18 12:41:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 08:41:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f64ab0fa0795_80bb5e4fec1300904@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 Fri Sep 18 13:54:58 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 18 Sep 2020 09:54:58 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f64bc32e0634_80b3f8495f08f1c13029671@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: fd453290 by Sebastian Graf at 2020-09-18T15:54:08+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitants]` why we still have to stick to "test" (1). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitants` is more careful at suggesting the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 14 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitants 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitants vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd4532902aec86f8bff6321fd7672ad467bec6cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd4532902aec86f8bff6321fd7672ad467bec6cc You're receiving 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 18 14:14:21 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 18 Sep 2020 10:14:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-8.6-tsan-2 Message-ID: <5f64c0bd79987_80bf28e2f413031479@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-8.6-tsan-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-8.6-tsan-2 You're receiving 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 18 14:37:46 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 10:37:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/all Message-ID: <5f64c63a70b41_80bd87a46c130348c3@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/tsan/all at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/all You're receiving 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 18 14:41:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 10:41:40 -0400 Subject: [Git][ghc/ghc][wip/tsan/all] CI Message-ID: <5f64c7246bc38_80bd87a46c130382a5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tsan/all at Glasgow Haskell Compiler / GHC Commits: c6f34d42 by GHC GitLab CI at 2020-09-18T14:41:33+00:00 CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -636,12 +636,21 @@ nightly-x86_64-linux-deb9-integer-simple: TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest -nightly-x86_64-linux-deb9-tsan: +.build-x86_64-linux-deb9-tsan: extends: .build-x86_64-linux-deb9 stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" FLAVOUR: "thread-sanitizer" + TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + +nightly-x86_64-linux-deb9-tsan: + <<: *nightly + extends: .build-x86_64-linux-deb9-tsan: + +validate-x86_64-linux-deb9-tsan: + extends: .build-x86_64-linux-deb9-tsan: + when: manual validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f34d42b5efaa291a8b7479d643eea7066534b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6f34d42b5efaa291a8b7479d643eea7066534b0 You're receiving 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 18 14:42:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 10:42:45 -0400 Subject: [Git][ghc/ghc][wip/tsan/all] CI Message-ID: <5f64c765b3f2a_80b3f849024b194130388bc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tsan/all at Glasgow Haskell Compiler / GHC Commits: 7398ccdf by GHC GitLab CI at 2020-09-18T14:42:39+00:00 CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -636,12 +636,21 @@ nightly-x86_64-linux-deb9-integer-simple: TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest -nightly-x86_64-linux-deb9-tsan: +.build-x86_64-linux-deb9-tsan: extends: .build-x86_64-linux-deb9 stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" FLAVOUR: "thread-sanitizer" + TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + +nightly-x86_64-linux-deb9-tsan: + <<: *nightly + extends: .build-x86_64-linux-deb9-tsan + +validate-x86_64-linux-deb9-tsan: + extends: .build-x86_64-linux-deb9-tsan + when: manual validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7398ccdfc82b9a2a1dbb8d706c97353bcc930b45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7398ccdfc82b9a2a1dbb8d706c97353bcc930b45 You're receiving 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 18 14:48:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 10:48:50 -0400 Subject: [Git][ghc/ghc][wip/bump-llvm] 643 commits: gitlab-ci: Allow ARMv7 job to fail Message-ID: <5f64c8d29aee4_80b3f849ca94a74130404f9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-llvm at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 407c95e6 by Ben Gamari at 2020-09-18T10:48:03-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 22 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - README.md - 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/f468dded129bcdfb0f7eb4d79cb644907dd92005...407c95e6e5426eabed58a7b9dc0b88bff7b4f3e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f468dded129bcdfb0f7eb4d79cb644907dd92005...407c95e6e5426eabed58a7b9dc0b88bff7b4f3e0 You're receiving 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 18 14:59:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 10:59:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/windows-ci Message-ID: <5f64cb3ee1793_80baf08a0c13043133@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/windows-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/windows-ci You're receiving 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 18 15:00:29 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 18 Sep 2020 11:00:29 -0400 Subject: [Git][ghc/ghc][wip/bump-base-4.16] Version bump: base-4.16 (#18712) Message-ID: <5f64cb8d374a3_80bf0282a81304474e@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC Commits: 601b2601 by Vladislav Zavialov at 2020-09-18T17:56:59+03:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 30 changed files: - compiler/ghc.cabal.in - libraries/array - libraries/base/base.cabal - libraries/base/changelog.md - libraries/deepseq - libraries/directory - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/unix - testsuite/tests/dependent/should_compile/T14729.stderr - testsuite/tests/dependent/should_compile/T15743.stderr - testsuite/tests/dependent/should_compile/T15743e.stderr - testsuite/tests/indexed-types/should_compile/T15711.stderr - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/polykinds/T15592.stderr - testsuite/tests/polykinds/T15592b.stderr - testsuite/tests/printer/T18052a.stderr - testsuite/tests/typecheck/should_compile/T12763.stderr - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - utils/haddock The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/601b2601ee73aa1d2e801f4aa370d3be51f02813 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/601b2601ee73aa1d2e801f4aa370d3be51f02813 You're receiving 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 18 15:20:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 11:20:38 -0400 Subject: [Git][ghc/ghc][wip/windows-ci] 3 commits: base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Message-ID: <5f64d0465ca01_80b114abcd813048916@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/windows-ci at Glasgow Haskell Compiler / GHC Commits: b6c00ccd by Ben Gamari at 2020-09-18T11:01:21-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - b956c0a4 by Ben Gamari at 2020-09-18T11:04:20-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ad20b09f by Ben Gamari at 2020-09-18T11:20:32-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - 6 changed files: - libraries/base/tests/Concurrent/ThreadDelay001.hs - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/rts/T12771/all.T - testsuite/tests/rts/T13082/all.T - testsuite/tests/rts/T14611/all.T - testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 Changes: ===================================== libraries/base/tests/Concurrent/ThreadDelay001.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} -- Test that threadDelay actually sleeps for (at least) as long as we -- ask it ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -30,10 +30,12 @@ test('T10458', ghci_script, ['T10458.script']) test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_msvc']) ===================================== testsuite/tests/rts/T12771/all.T ===================================== @@ -1,4 +1,5 @@ test('T12771', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T12771']) ===================================== testsuite/tests/rts/T13082/all.T ===================================== @@ -16,6 +16,7 @@ def normalise_search_dirs (str): #-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T13082_good']) ===================================== testsuite/tests/rts/T14611/all.T ===================================== @@ -1,4 +1,5 @@ test('T14611', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T14611']) ===================================== testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 ===================================== @@ -1 +1 @@ -outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. +outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20396568e261410a9bb3f9fd45dcc54ae32dbe7f...ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20396568e261410a9bb3f9fd45dcc54ae32dbe7f...ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a You're receiving 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 18 16:29:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 12:29:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/drop-cleanup Message-ID: <5f64e07f625d5_80bd848de0130679cd@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/drop-cleanup at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/drop-cleanup You're receiving 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 18 17:04:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 13:04:37 -0400 Subject: [Git][ghc/ghc][wip/perf-ci] 7 commits: Introduce OutputableP Message-ID: <5f64e8a5384ba_80b3f8486aa2c34130714e0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/perf-ci at Glasgow Haskell Compiler / GHC Commits: ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 32d87ee3 by Ben Gamari at 2020-09-18T13:04:32-04:00 ci.sh: Factor out common utilities - - - - - c20aac79 by Ben Gamari at 2020-09-18T13:04:32-04:00 ci: Add ad-hoc performance testing rule - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ff42bbe2136b12e6d4f5b347e65affd51aaf021...c20aac7991774dc71cc43e151187e6f7c85d9d08 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ff42bbe2136b12e6d4f5b347e65affd51aaf021...c20aac7991774dc71cc43e151187e6f7c85d9d08 You're receiving 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 18 18:01:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 14:01:20 -0400 Subject: [Git][ghc/ghc][wip/happy-1.20] 35 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f64f5f01cf1f_80b3f8469e91b6413096142@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/happy-1.20 at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 258b0ed4 by Vladislav Zavialov at 2020-09-18T13:58:16-04:00 Require happy >=1.20 - - - - - 4882dedb by Ben Gamari at 2020-09-18T13:58:16-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - c0716fcc by Ben Gamari at 2020-09-18T14:00:02-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d565984c54c82305349e215b0332253f6ed592d9...c0716fcc7e8de24c3ca4dd2a714a848661991f1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d565984c54c82305349e215b0332253f6ed592d9...c0716fcc7e8de24c3ca4dd2a714a848661991f1f You're receiving 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 18 19:03:15 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 18 Sep 2020 15:03:15 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 51 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f6504734568d_80bb10c6641310479@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 9fe83f2d by Vladislav Zavialov at 2020-09-18T22:03:04+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - README.md - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cb5296d63ba73ba5dffdaa492ddf012d54d1c0d...9fe83f2d364c69ab4c9c88baaeb1a961d6ffa9a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3cb5296d63ba73ba5dffdaa492ddf012d54d1c0d...9fe83f2d364c69ab4c9c88baaeb1a961d6ffa9a8 You're receiving 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 18 19:49:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 15:49:45 -0400 Subject: [Git][ghc/ghc][wip/tsan/all] CI Message-ID: <5f650f59a768b_80b3f848a2dd9f0131176a4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tsan/all at Glasgow Haskell Compiler / GHC Commits: d369bb64 by GHC GitLab CI at 2020-09-18T19:49:39+00:00 CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -636,12 +636,21 @@ nightly-x86_64-linux-deb9-integer-simple: TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest -nightly-x86_64-linux-deb9-tsan: +.build-x86_64-linux-deb9-tsan: extends: .build-x86_64-linux-deb9 stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "thread-sanitizer" + TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + +nightly-x86_64-linux-deb9-tsan: + <<: *nightly + extends: .build-x86_64-linux-deb9-tsan + +validate-x86_64-linux-deb9-tsan: + extends: .build-x86_64-linux-deb9-tsan + when: manual validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d369bb642b66f57125819002f5194700a72db2e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d369bb642b66f57125819002f5194700a72db2e4 You're receiving 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 18 19:55:55 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Sep 2020 15:55:55 -0400 Subject: [Git][ghc/ghc][master] rts/nonmoving: Add missing STM write barrier Message-ID: <5f6510cb8d08b_80b3f848c213fb81311989@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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/0799b3de3e3462224bddc0e4b6a3156d04a06361 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0799b3de3e3462224bddc0e4b6a3156d04a06361 You're receiving 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 18 19:56:32 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Sep 2020 15:56:32 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Refactor foreign export tracking Message-ID: <5f6510f054f71_80b101ae5a41312199b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 10 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/LinkerInternals.h - 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 = pprModuleName (moduleName mod) + ctor_symbol = text "stginit_export_" <> mod_str + list_symbol = text "stg_exports_" <> 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,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); + ===================================== 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) { + struct 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->foreign_exports; + cur->oc->foreign_exports = 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,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.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,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; } static void @@ -1434,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif @@ -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 */ + struct 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 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0799b3de3e3462224bddc0e4b6a3156d04a06361...40dc91069d15bfc1d81f1722b39e06cac8fdddd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0799b3de3e3462224bddc0e4b6a3156d04a06361...40dc91069d15bfc1d81f1722b39e06cac8fdddd1 You're receiving 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 18 19:58:49 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 18 Sep 2020 15:58:49 -0400 Subject: [Git][ghc/ghc][wip/derived-refactor] More checkpoint. Moar. Message-ID: <5f651179d5c0f_80b3f848a2dd9f01312444c@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/derived-refactor at Glasgow Haskell Compiler / GHC Commits: 24f51ff6 by Richard Eisenberg at 2020-09-18T15:58:28-04:00 More checkpoint. Moar. - - - - - 1 changed file: - + testsuite/tests/dependent/should_compile/LopezJuan.hs Changes: ===================================== testsuite/tests/dependent/should_compile/LopezJuan.hs ===================================== @@ -0,0 +1,57 @@ +{- + +This test is inspired by + Practical dependent type checking using twin types + Victor López Juan and Nils Anders Danielsson + TyDe '20 + https://dl.acm.org/doi/10.1145/3406089.3409030 +-} + +{-# LANGUAGE TypeOperators, TypeApplications, DataKinds, + StandaloneKindSignatures, PolyKinds, GADTs, + TypeFamilies #-} + +module LopezJuan where + +import Data.Type.Equality ( (:~~:)(..) ) +import Data.Kind ( Type ) + +-- amazingly, this worked without modification + +data SBool :: Bool -> Type where + SFalse :: SBool False + STrue :: SBool True + +data BoolOp where + None :: Bool -> BoolOp + Some :: Bool -> BoolOp + +type F :: Bool -> Type +type family F b + +get :: BoolOp -> Bool +get (None _) = True +get (Some x) = x + +type Get :: BoolOp -> Bool +type family Get x where + Get (None _) = True + Get (Some x) = x + +type TyFun :: Type -> Type -> Type +data TyFun arg res + +type (~>) :: Type -> Type -> Type +type arg ~> res = TyFun arg res -> Type +infixr 0 ~> + +type (@@) :: (a ~> b) -> a -> b +type family f @@ arg + +data Const :: a -> (b ~> a) + +f :: SBool x -> (:~~:) @(F (Get (_alpha x)) ~> BoolOp) + @(F True ~> BoolOp) + (Const (None x)) + (Const (_alpha x)) +f _ = HRefl View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24f51ff65369485ec23bf24d8d0f6b207598e7a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24f51ff65369485ec23bf24d8d0f6b207598e7a5 You're receiving 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 18 20:27:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 18 Sep 2020 16:27:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: rts/nonmoving: Add missing STM write barrier Message-ID: <5f651832ce579_80b7814258131291f0@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40b0fbbb by Simon Jakobi at 2020-09-18T16:27:12-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 1f78b0fd by Hécate at 2020-09-18T16:27:15-04:00 Remove the list of loaded modules from the ghci prompt - - - - - b1cd6cdc by Sylvain Henry at 2020-09-18T16:27:19-04:00 Bump Stack resolver - - - - - bb2f6555 by John Ericson at 2020-09-18T16:27:21-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - fb9d916e by Sylvain Henry at 2020-09-18T16:27:21-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8e9cf317 by Andreas Klebinger at 2020-09-18T16:27:21-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 96ab06e7 by Andreas Klebinger at 2020-09-18T16:27:21-04:00 Fix a codeblock in ghci.rst - - - - - 04140740 by Ben Gamari at 2020-09-18T16:27:21-04:00 users guide: Fix various documentation issues - - - - - a4fb1097 by Ben Gamari at 2020-09-18T16:27:21-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - 46559e8e by David Feuer at 2020-09-18T16:27:23-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 11c0c333 by Ben Gamari at 2020-09-18T16:27:23-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 30 changed files: - compiler/GHC/HsToCore/Foreign/Decl.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 - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/ghc-bin.cabal.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/stack.yaml - includes/Rts.h - + includes/rts/ForeignExports.h - libraries/base/Data/Semigroup.hs - libraries/base/changelog.md - libraries/deepseq - libraries/ghc-compact/GHC/Compact.hs - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/LinkerInternals.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/STM.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fa917e05113518b24225c3ef85205be22c4b005...11c0c3338045c56eea668631db956a728168463e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fa917e05113518b24225c3ef85205be22c4b005...11c0c3338045c56eea668631db956a728168463e You're receiving 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 18 21:16:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 17:16:51 -0400 Subject: [Git][ghc/ghc][wip/windows-ci] 11 commits: rts/nonmoving: Add missing STM write barrier Message-ID: <5f6523c3b2f41_80b10ade4e4131428df@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/windows-ci at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 9eee39a6 by Ben Gamari at 2020-09-18T17:16:06-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 863699ca by Ben Gamari at 2020-09-18T17:16:06-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 3a9c8bc3 by Ben Gamari at 2020-09-18T17:16:06-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - 72a650e0 by Ben Gamari at 2020-09-18T17:16:06-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - 12575510 by Ben Gamari at 2020-09-18T17:16:06-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - 1ead0a27 by GHC GitLab CI at 2020-09-18T17:16:06-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - d4d61d2f by GHC GitLab CI at 2020-09-18T17:16:06-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - be124deb by GHC GitLab CI at 2020-09-18T17:16:06-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 22 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - libraries/base/tests/Concurrent/ThreadDelay001.hs - libraries/base/tests/all.T - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/LinkerInternals.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/STM.c - rts/rts.cabal.in - testsuite/driver/testlib.py - testsuite/tests/driver/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/rts/T12771/all.T - testsuite/tests/rts/T13082/all.T - testsuite/tests/rts/T14611/all.T - testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 - testsuite/tests/th/all.T 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 = pprModuleName (moduleName mod) + ctor_symbol = text "stginit_export_" <> mod_str + list_symbol = text "stg_exports_" <> 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,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); + ===================================== libraries/base/tests/Concurrent/ThreadDelay001.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} -- Test that threadDelay actually sleeps for (at least) as long as we -- ask it ===================================== libraries/base/tests/all.T ===================================== @@ -17,7 +17,10 @@ test('readFloat', exit_code(1), compile_and_run, ['']) test('enumDouble', normal, compile_and_run, ['']) test('enumRatio', normal, compile_and_run, ['']) test('enumNumeric', normal, compile_and_run, ['']) -test('tempfiles', normal, compile_and_run, ['']) +# N.B. the tempfile format is slightly different than this test expects on +# Windows *except* if using WinIO. The `when` clause below can be removed +# after WinIO becomes the default. +test('tempfiles', when(opsys('mingw32'), only_ways(['winio'])), compile_and_run, ['']) test('fixed', normal, compile_and_run, ['']) test('quotOverflow', normal, compile_and_run, ['']) test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts']) ===================================== 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) { + struct 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->foreign_exports; + cur->oc->foreign_exports = 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,21 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "Rts.h" +#include "LinkerInternals.h" + +#include "BeginPrivate.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,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + struct 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; i++) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; } static void @@ -1434,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize, oc->n_segments = 0; oc->segments = NULL; oc->proddables = NULL; - oc->stable_ptrs = NULL; + oc->foreign_exports = NULL; #if defined(NEED_SYMBOL_EXTRAS) oc->symbol_extras = NULL; #endif @@ -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 */ + struct 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/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 ===================================== 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/driver/testlib.py ===================================== @@ -751,22 +751,24 @@ def normalise_win32_io_errors(name, opts): slightly in the error messages that they provide. Normalise these differences away, preferring the new WinIO errors. - This can be dropped when the old IO manager is removed. + This normalization can be dropped when the old IO manager is removed. """ SUBS = [ - ('Bad file descriptor', 'The handle is invalid'), + ('Bad file descriptor', 'The handle is invalid.'), ('Permission denied', 'Access is denied.'), ('No such file or directory', 'The system cannot find the file specified.'), ] - def f(s: str): + def normalizer(s: str) -> str: for old,new in SUBS: s = s.replace(old, new) return s - return when(opsys('mingw32'), normalise_fun(f)) + if opsys('mingw32'): + _normalise_fun(name, opts, normalizer) + _normalise_errmsg_fun(name, opts, normalizer) def normalise_version_( *pkgs ): def normalise_version__( str ): ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) +test('T12971', ignore_stdout, makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -30,10 +30,12 @@ test('T10458', ghci_script, ['T10458.script']) test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_msvc']) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -142,10 +142,10 @@ test('T5979', normalise_version("transformers")], ghci_script, ['T5979.script']) test('T5975a', - [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + 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'), when(opsys('mingw32'), expect_broken(7305))], + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) ===================================== testsuite/tests/rts/T12771/all.T ===================================== @@ -1,4 +1,5 @@ test('T12771', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T12771']) ===================================== testsuite/tests/rts/T13082/all.T ===================================== @@ -16,6 +16,7 @@ def normalise_search_dirs (str): #-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T13082_good']) ===================================== testsuite/tests/rts/T14611/all.T ===================================== @@ -1,4 +1,5 @@ test('T14611', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T14611']) ===================================== testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 ===================================== @@ -1 +1 @@ -outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. +outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. ===================================== testsuite/tests/th/all.T ===================================== @@ -51,7 +51,8 @@ test('TH_NestedSplices', [], multimod_compile, # normal way first, which is why the work is done by a Makefile rule. test('TH_spliceE5_prof', [req_profiling, only_ways(['normal']), - when(ghc_dynamic(), expect_broken(11495))], + when(ghc_dynamic(), expect_broken(11495)), + when(opsys('mingw32'), expect_broken(18271))], makefile_test, ['TH_spliceE5_prof']) test('TH_spliceE5_prof_ext', [req_profiling, only_ways(['normal'])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a...be124deb9ee8104fba9c711d8b6e9a5158f00b00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a...be124deb9ee8104fba9c711d8b6e9a5158f00b00 You're receiving 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 18 21:49:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 17:49:58 -0400 Subject: [Git][ghc/ghc][wip/backports-8.10] 3 commits: Bump text submodule to 1.2.4.0+ Message-ID: <5f652b86ab825_80b3f84866dcf78131448dd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC Commits: 40a1e442 by Ben Gamari at 2020-09-18T17:49:52-04:00 Bump text submodule to 1.2.4.0+ Fixes #18588 and #17956. - - - - - 51e8292e by Ömer Sinan Ağacan at 2020-09-18T17:49:52-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 (cherry picked from commit 08c1cb0f30770acbf366423f085f8ef92f7f6a06) - - - - - 4900b04f by GHC GitLab CI at 2020-09-18T17:49:52-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) - - - - - 10 changed files: - aclocal.m4 - compiler/main/SysTools/Settings.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - libraries/text - mk/config.mk.in - rts/Linker.c - rules/build-package-way.mk - utils/ghc-cabal/ghc.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) @@ -2589,7 +2599,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]) @@ -2609,33 +2619,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/main/SysTools/Settings.hs ===================================== @@ -141,7 +141,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 ===================================== @@ -429,6 +429,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@ @@ -114,10 +115,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 ===================================== @@ -313,7 +313,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/text ===================================== @@ -1 +1 @@ -Subproject commit c6768a2a07e94b8b26d0f0e53517773de1110ce2 +Subproject commit e07c14940c25f33fe5b282912d745d3a79dd4ade ===================================== mk/config.mk.in ===================================== @@ -556,6 +556,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.c ===================================== @@ -1371,23 +1371,6 @@ void freeObjectCode (ObjectCode *oc) stgFree(oc); } -/* ----------------------------------------------------------------------------- -* Sets the initial status of a fresh ObjectCode -*/ -static void setOcInitialStatus(ObjectCode* oc) { - /* If a target has requested the ObjectCode not to be resolved then - honor this requests. Usually this means the ObjectCode has not been - initialized and can't be. */ - if (oc->status == OBJECT_DONT_RESOLVE) - return; - - if (oc->archiveMemberName == NULL) { - oc->status = OBJECT_NEEDED; - } else { - oc->status = OBJECT_LOADED; - } -} - ObjectCode* mkOc( pathchar *path, char *image, int imageSize, bool mapped, char *archiveMemberName, int misalignment ) { @@ -1420,7 +1403,11 @@ mkOc( pathchar *path, char *image, int imageSize, oc->archiveMemberName = NULL; } - setOcInitialStatus( oc ); + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } oc->fileSize = imageSize; oc->symbols = NULL; @@ -1711,8 +1698,17 @@ HsInt loadOc (ObjectCode* oc) # endif #endif - /* loaded, but not resolved yet, ensure the OC is in a consistent state */ - setOcInitialStatus( oc ); + /* Loaded, but not resolved yet, ensure the OC is in a consistent state. + If a target has requested the ObjectCode not to be resolved then honor + this requests. Usually this means the ObjectCode has not been initialized + and can't be. */ + if (oc->status != OBJECT_DONT_RESOLVE) { + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } + } IF_DEBUG(linker, debugBelch("loadOc: done.\n")); return 1; ===================================== 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" ===================================== utils/ghc-cabal/ghc.mk ===================================== @@ -75,7 +75,7 @@ $(ghc-cabal_DIST_BINARY): $(CABAL_LEXER_DEP) utils/ghc-cabal/Main.hs $(TOUCH_DEP -ilibraries/filepath \ -ilibraries/hpc \ -ilibraries/mtl \ - -ilibraries/text \ + -ilibraries/text/src \ libraries/text/cbits/cbits.c \ -Ilibraries/text/include \ -ilibraries/parsec/src \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dbe36f62e27f61fd4e1bb99ce8bf71783bd713da...4900b04fa7b8fa1354e757bfcf23ca462068caee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dbe36f62e27f61fd4e1bb99ce8bf71783bd713da...4900b04fa7b8fa1354e757bfcf23ca462068caee You're receiving 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 18 21:50:11 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 18 Sep 2020 17:50:11 -0400 Subject: [Git][ghc/ghc][wip/derived-refactor] Actually checkpoint properly. Message-ID: <5f652b9342d1e_80b3f84960bf1d0131453af@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/derived-refactor at Glasgow Haskell Compiler / GHC Commits: f550eed8 by Richard Eisenberg at 2020-09-18T17:49:50-04:00 Actually checkpoint properly. - - - - - 19 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Id/Make.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr - testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr - testsuite/tests/indexed-types/should_fail/T13972.hs - testsuite/tests/indexed-types/should_fail/T14230a.stderr - testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr - testsuite/tests/polykinds/T14172.stderr - testsuite/tests/th/T11452.stderr Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -556,9 +556,15 @@ instance Outputable ErrorItem where -- | Makes an error item from a constraint, calculating whether or not -- the item should be suppressed. See Note [Wanteds rewrite Wanteds] --- in GHC.Tc.Types.Constraint -mkErrorItem :: Ct -> TcM ErrorItem +-- in GHC.Tc.Types.Constraint. Returns Nothing if we should just ignore +-- a constraint. See Note [Constraints to ignore]. +mkErrorItem :: Ct -> TcM (Maybe ErrorItem) mkErrorItem ct + | AssocFamPatOrigin <- ctOrigin ct + = do { traceTc "Ignoring constraint:" (ppr ct) + ; return Nothing } -- See Note [Constraints to ignore] + + | otherwise = do { let loc = ctLoc ct flav = ctFlavour ct @@ -569,11 +575,11 @@ mkErrorItem ct ; return (supp, Just dest) } CtDerived {} -> return (False, Nothing) - ; return $ EI { ei_pred = ctPred ct - , ei_evdest = m_evdest - , ei_flavour = flav - , ei_loc = loc - , ei_suppress = suppress }} + ; return $ Just $ EI { ei_pred = ctPred ct + , ei_evdest = m_evdest + , ei_flavour = flav + , ei_loc = loc + , ei_suppress = suppress }} {- "RAE" tidyErrorItem :: TidyEnv -> ErrorItem -> ErrorItem @@ -610,7 +616,7 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_impl = implics , text "tidy_holes =" <+> ppr tidy_holes ]) -} - ; tidy_items <- mapM mkErrorItem tidy_cts + ; tidy_items <- mapMaybeM mkErrorItem tidy_cts ; traceTc "reportWanteds 1" (vcat [ text "Simples =" <+> ppr simples , text "Suppress =" <+> ppr (cec_suppress ctxt) , text "tidy_cts =" <+> ppr tidy_cts @@ -837,6 +843,43 @@ We use the `suppress` function within reportWanteds to filter out these two cases, then report all other errors. Lastly, we return to these suppressed ones and report them only if there have been no errors so far. +Note [Constraints to ignore] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some constraints are meant only to aid the solver by unification; a failure +to solve them is not necessarily an error to report to the user. It is critical +that compilation is aborted elsewhere if there are any ignored constraints here; +they will remain unfilled, and might have been used to rewrite another constraint. + +Currently, the constraints to ignore are: + +1) Constraints generated in order to unify associated type instance parameters + with class parameters. Here are two illustrative examples: + + class C (a :: k) where + type F (b :: k) + + instance C True where + type F a = Int + + instance C Left where + type F (Left :: a -> Either a b) = Bool + + In the first instance, we want to infer that `a` has type Bool. So we emit + a constraint unifying kappa (the guessed type of `a`) with Bool. All is well. + + In the second instance, we process the associated type instance only + after fixing the quantified type variables of the class instance. We thus + have skolems a1 and b1 such that the class instance is for (Left :: a1 -> Either a1 b1). + Unifying a1 and b1 with a and b in the type instance will fail, but harmlessly so. + checkConsistentFamInst checks for this, and will fail if anything has gone + awry. Really the equality constraints emitted are just meant as an aid, not + a requirement. This is test case T13972. + + We detect this case by looking for an origin of AssocFamPatOrigin; constraints + with this origin are dropped entirely during error message reporting. + + If there is any trouble, checkValidFamInst bleats, aborting compilation. + -} ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -37,6 +37,8 @@ import GHC.Tc.Utils.Env import GHC.Tc.Utils.Unify import GHC.Tc.Solver import GHC.Tc.Types.Evidence +import GHC.Tc.Types.Constraint +import GHC.Core.Predicate import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType @@ -791,7 +793,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list ; let inferred_theta = map evVarPred givens ; exports <- checkNoErrs $ - mapM (mkExport prag_fn insoluble qtvs inferred_theta) mono_infos + mapM (mkExport prag_fn residual insoluble qtvs inferred_theta) mono_infos ; loc <- getSrcSpanM ; let poly_ids = map abe_poly exports @@ -808,6 +810,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list -------------- mkExport :: TcPragEnv + -> WantedConstraints -- residual constraints, already emitted (for errors only) -> Bool -- True <=> there was an insoluble type error -- when typechecking the bindings -> [TyVar] -> TcThetaType -- Both already zonked @@ -826,12 +829,12 @@ mkExport :: TcPragEnv -- Pre-condition: the qtvs and theta are already zonked -mkExport prag_fn insoluble qtvs theta +mkExport prag_fn residual insoluble qtvs theta mono_info@(MBI { mbi_poly_name = poly_name , mbi_sig = mb_sig , mbi_mono_id = mono_id }) = do { mono_ty <- zonkTcType (idType mono_id) - ; poly_id <- mkInferredPolyId insoluble qtvs theta poly_name mb_sig mono_ty + ; poly_id <- mkInferredPolyId residual insoluble qtvs theta poly_name mb_sig mono_ty -- NB: poly_id has a zonked type ; poly_id <- addInlinePrags poly_id prag_sigs @@ -867,12 +870,13 @@ mkExport prag_fn insoluble qtvs theta prag_sigs = lookupPragEnv prag_fn poly_name sig_ctxt = InfSigCtxt poly_name -mkInferredPolyId :: Bool -- True <=> there was an insoluble error when +mkInferredPolyId :: WantedConstraints -- the residual constraints, already emitted + -> Bool -- True <=> there was an insoluble error when -- checking the binding group for this Id -> [TyVar] -> TcThetaType -> Name -> Maybe TcIdSigInst -> TcType -> TcM TcId -mkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty +mkInferredPolyId residual insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty | Just (TISI { sig_inst_sig = sig }) <- mb_sig_inst , CompleteSig { sig_bndr = poly_id } <- sig = return poly_id @@ -893,7 +897,7 @@ mkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty -- We can discard the coercion _co, because we'll reconstruct -- it in the call to tcSubType below - ; (binders, theta') <- chooseInferredQuantifiers inferred_theta + ; (binders, theta') <- chooseInferredQuantifiers residual inferred_theta (tyCoVarsOfType mono_ty') qtvs mb_sig_inst ; let inferred_poly_ty = mkForAllTys binders (mkPhiTy theta' mono_ty') @@ -911,12 +915,13 @@ mkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty ; return (mkLocalId poly_name inferred_poly_ty) } -chooseInferredQuantifiers :: TcThetaType -- inferred +chooseInferredQuantifiers :: WantedConstraints -- residual constraints + -> TcThetaType -- inferred -> TcTyVarSet -- tvs free in tau type -> [TcTyVar] -- inferred quantified tvs -> Maybe TcIdSigInst -> TcM ([TyVarBinder], TcThetaType) -chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing +chooseInferredQuantifiers _residual inferred_theta tau_tvs qtvs Nothing = -- No type signature (partial or complete) for this binder, do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs) -- Include kind variables! #7916 @@ -926,11 +931,11 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing , tv `elemVarSet` free_tvs ] ; return (binders, my_theta) } -chooseInferredQuantifiers inferred_theta tau_tvs qtvs - (Just (TISI { sig_inst_sig = sig -- Always PartialSig - , sig_inst_wcx = wcx - , sig_inst_theta = annotated_theta - , sig_inst_skols = annotated_tvs })) +chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs + (Just (TISI { sig_inst_sig = sig@(PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty }) + , sig_inst_wcx = wcx + , sig_inst_theta = annotated_theta + , sig_inst_skols = annotated_tvs })) = -- Choose quantifiers for a partial type signature do { psig_qtv_prs <- zonkTyVarTyVarPairs annotated_tvs @@ -943,8 +948,8 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs -- signature is not actually quantified. How can that happen? -- See Note [Quantification and partial signatures] Wrinkle 4 -- in GHC.Tc.Solver - ; mapM_ report_mono_sig_tv_err [ n | (n,tv) <- psig_qtv_prs - , not (tv `elem` qtvs) ] + ; mapM_ report_mono_sig_tv_err [ pr | pr@(_,tv) <- psig_qtv_prs + , not (tv `elem` qtvs) ] ; let psig_qtvs = mkVarSet (map snd psig_qtv_prs) @@ -961,22 +966,28 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs ; return (final_qtvs, my_theta) } where report_dup_tyvar_tv_err (n1,n2) - | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig = addErrTc (hang (text "Couldn't match" <+> quotes (ppr n1) <+> text "with" <+> quotes (ppr n2)) 2 (hang (text "both bound by the partial type signature:") 2 (ppr fn_name <+> dcolon <+> ppr hs_ty))) - | otherwise -- Can't happen; by now we know it's a partial sig - = pprPanic "report_tyvar_tv_err" (ppr sig) - - report_mono_sig_tv_err n - | PartialSig { psig_name = fn_name, psig_hs_ty = hs_ty } <- sig + report_mono_sig_tv_err (n,tv) = addErrTc (hang (text "Can't quantify over" <+> quotes (ppr n)) - 2 (hang (text "bound by the partial type signature:") - 2 (ppr fn_name <+> dcolon <+> ppr hs_ty))) - | otherwise -- Can't happen; by now we know it's a partial sig - = pprPanic "report_mono_sig_tv_err" (ppr sig) + 2 (vcat [ hang (text "bound by the partial type signature:") + 2 (ppr fn_name <+> dcolon <+> ppr hs_ty) + , extra ])) + where + extra | rhs_ty:_ <- [ rhs + -- recall that residuals are always implications + | residual_implic <- bagToList $ wc_impl residual + , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic) + , let residual_pred = ctPred residual_ct + , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ] + , Just lhs_tv <- [ tcGetTyVar_maybe lhs ] + , lhs_tv == tv ] + = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ] + | otherwise + = empty choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType -> TcM (VarSet, TcThetaType) @@ -1021,6 +1032,8 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs -- Hack alert! See GHC.Tc.Gen.HsType: -- Note [Extra-constraint holes in partial type signatures] +chooseInferredQuantifiers _ _ _ _ (Just (TISI { sig_inst_sig = sig@(CompleteSig {}) })) + = pprPanic "chooseInferredQuantifiers" (ppr sig) mk_impedance_match_msg :: MonoBindInfo -> TcType -> TcType ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1730,7 +1730,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) ; tau <- zonkTcType tau ; let inferred_theta = map evVarPred givens tau_tvs = tyCoVarsOfType tau - ; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta + ; (binders, my_theta) <- chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs (Just sig_inst) ; let inferred_sigma = mkInfSigmaTy qtvs inferred_theta tau my_sigma = mkForAllTys binders (mkPhiTy my_theta tau) ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -131,10 +131,8 @@ matchGlobalInst :: DynFlags -- See Note [Shortcut solving: overlap] -> Class -> [Type] -> TcM ClsInstResult matchGlobalInst dflags short_cut clas tys - | cls_name == knownNatClassName - = matchKnownNat dflags short_cut clas tys - | cls_name == knownSymbolClassName - = matchKnownSymbol dflags short_cut clas tys + | cls_name == knownNatClassName = matchKnownNat dflags short_cut clas tys + | cls_name == knownSymbolClassName = matchKnownSymbol dflags short_cut clas tys | isCTupleClass clas = matchCTuple clas tys | cls_name == typeableClassName = matchTypeable clas tys | clas `hasKey` heqTyConKey = matchHeteroEquality tys ===================================== compiler/GHC/Tc/Instance/Family.hs ===================================== @@ -162,9 +162,7 @@ addressed yet. newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcM FamInst -- Freshen the type variables of the FamInst branches newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) - = ASSERT2( tyCoVarsOfTypes lhs `subVarSet` tcv_set, text "lhs" <+> pp_ax ) - ASSERT2( lhs_kind `eqType` rhs_kind, text "kind" <+> pp_ax $$ ppr lhs_kind $$ ppr rhs_kind ) - -- We used to have an assertion that the tyvars of the RHS were bound + = -- We used to have an assertion that the tyvars of the RHS were bound -- by tcv_set, but in error situations like F Int = a that isn't -- true; a later check in checkValidFamInst rejects it do { (subst, tvs') <- freshenTyVarBndrs tvs @@ -199,10 +197,6 @@ newFamInst flavor axiom@(CoAxiom { co_ax_tc = fam_tc }) , fi_rhs = rhs' , fi_axiom = axiom }) } where - lhs_kind = tcTypeKind (mkTyConApp fam_tc lhs) - rhs_kind = tcTypeKind rhs - tcv_set = mkVarSet (tvs ++ cvs) - pp_ax = pprCoAxiom axiom CoAxBranch { cab_tvs = tvs , cab_cvs = cvs , cab_lhs = lhs ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1147,7 +1147,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates -- we want to find any other variables that are determined by this -- set, by functional dependencies or equalities. We thus use -- oclose to find all further variables determined by this root - -- set. + -- set. "RAE" update comments mono_tvs2 = oclose candidates mono_tvs1 @@ -1382,7 +1382,7 @@ pickQuantifiablePreds qtvs theta && (checkValidClsArgs flex_ctxt cls tys) -- Only quantify over predicates that checkValidType -- will pass! See #10351. - && (no_fixed_dependencies cls tys) + && (no_fixed_dependencies cls tys) -- "RAE": comment this line no_fixed_dependencies cls tys = and [ qtvs `intersectsVarSet` tyCoVarsOfTypes fd_lhs_tys @@ -2585,11 +2585,15 @@ floatConstraints skols given_ids ev_binds_var no_given_eqs -- in GHC.Tc.Solver.Monad ClassPred cls args | isIPClass cls - , [ip_name_strty, _ty] <- args - , Just ip_name <- isStrLitTy ip_name_strty - -> not (ip_name `elementOfUniqSet` given_ip_names) + , [ip_name_strty, ip_ty] <- args + , Just ip_name <- isStrLitTy ip_name_strty -- should always succeed + -> not (isCallStackTy ip_ty) && -- don't float HasCallStack, as this will always be solved + -- See Note [Overview of implicit CallStacks] + -- in GHC.Tc.Types.Evidence + not (ip_name `elementOfUniqSet` given_ip_names) | otherwise -> classHasFds cls + _ -> False -- The set of implicit parameters bound in the enclosing implication ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -168,6 +168,7 @@ canClassNC ev cls tys -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] + -- in GHC.Tc.Types.Evidence ; new_ev <- newWantedEvVarNC new_loc rewriters pred @@ -1600,7 +1601,25 @@ representational role]. See #10534 and test case typecheck/should_fail/T10534. {4}: Because type variables can stand in for newtypes, we conservatively do not -decompose AppTys over representational equality. +decompose AppTys over representational equality. Here are two examples that +demonstrate why we can't: + + 4a: newtype Phant a = MkPhant Int + [W] alpha Int ~R beta Bool + + If we eventually solve alpha := Phant and beta := Phant, then we can solve + this equality by unwrapping. But it would have been disastrous to decompose + the wanted to produce Int ~ Bool, which is definitely insoluble. + + 4b: newtype Age = MkAge Int + [W] alpha Age ~R Maybe Int + + First, a question: if we know that ty1 ~R ty2, can we conclude that + a ty1 ~R a ty2? Not for all a. This is precisely why we need role annotations + on type constructors. So, if we were to decompose, we would need to + decompose to [W] alpha ~R Maybe and [W] Age ~ Int. On the other hand, if we + later solve alpha := Maybe, then we would decompose to [W] Age ~R Int, and + that would be soluble. In the implementation of can_eq_nc and friends, we don't directly pattern match using lines like in the tables above, as those tables don't cover ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -2970,7 +2970,8 @@ addConsistencyConstraints mb_clsinfo fam_app , Just cls_ty <- [lookupVarEnv inst_env fam_tc_tv] ] ; traceTc "addConsistencyConstraints" (ppr eqs) ; emitDerivedEqs AssocFamPatOrigin eqs } - -- Improve inference + -- Improve inference; these equalities will not produce errors. + -- See Note [Constraints to ignore] in GHC.Tc.Errors -- Any mis-match is reports by checkConsistentFamInst | otherwise = return () ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -372,6 +372,8 @@ data CtOrigin | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc | AssocFamPatOrigin -- When matching the patterns of an associated -- family instance with that of its parent class + -- IMPORTANT: These constraints will never cause errors; + -- See Note [Constraints to ignore] in GHC.Tc.Errors | SectionOrigin | TupleOrigin -- (..,..) | ExprSigOrigin -- e :: ty ===================================== compiler/GHC/Tc/Utils/Zonk.hs ===================================== @@ -1833,11 +1833,6 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv }) -- (undeferred) type errors. Originally, I put in a panic -- here, but that caused too many uses of `failIfErrsM`. Nothing -> do { traceTc "Zonking unfilled coercion hole" (ppr hole) - ; when debugIsOn $ - whenNoErrs $ - MASSERT2( False - , text "Type-correct unfilled coercion hole" - <+> ppr hole ) ; cv' <- zonkCoVar cv ; return $ mkCoVarCo cv' } } -- This will be an out-of-scope variable, but keeping ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -826,7 +826,6 @@ For further reading, see: Note [Bangs on imported data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs from imported modules. ===================================== 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('LopezJuan', normal, compile, ['']) ===================================== testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr ===================================== @@ -1,29 +1,27 @@ PushedInAsGivens.hs:10:31: error: - • Could not deduce: a1 ~ a - from the context: F Int ~ [a1] + • Could not deduce: a ~ a0 + from the context: F Int ~ [a] bound by the type signature for: - foo :: forall a1. (F Int ~ [a1]) => a1 -> Int + foo :: forall a. (F Int ~ [a]) => a -> Int at PushedInAsGivens.hs:9:13-44 - ‘a1’ is a rigid type variable bound by + ‘a’ is a rigid type variable bound by the type signature for: - foo :: forall a1. (F Int ~ [a1]) => a1 -> Int + foo :: forall a. (F Int ~ [a]) => a -> Int at PushedInAsGivens.hs:9:13-44 - ‘a’ is a rigid type variable bound by - the inferred type of bar :: a -> (a, Int) - at PushedInAsGivens.hs:(9,1)-(11,20) • In the expression: y In the first argument of ‘length’, namely ‘[x, y]’ In the expression: length [x, y] • Relevant bindings include - x :: a1 (bound at PushedInAsGivens.hs:10:17) - foo :: a1 -> Int (bound at PushedInAsGivens.hs:10:13) - y :: a (bound at PushedInAsGivens.hs:9:5) - bar :: a -> (a, Int) (bound at PushedInAsGivens.hs:9:1) + x :: a (bound at PushedInAsGivens.hs:10:17) + foo :: a -> Int (bound at PushedInAsGivens.hs:10:13) + y :: a0 (bound at PushedInAsGivens.hs:9:5) + bar :: a0 -> (a0, Int) (bound at PushedInAsGivens.hs:9:1) PushedInAsGivens.hs:11:15: error: - • Couldn't match type ‘F Int’ with ‘[a]’ + • Couldn't match type ‘F Int’ with ‘[a0]’ arising from a use of ‘foo’ + The type variable ‘a0’ is ambiguous • In the expression: foo y In the expression: (y, foo y) In the expression: @@ -32,5 +30,5 @@ PushedInAsGivens.hs:11:15: error: foo x = length [...] in (y, foo y) • Relevant bindings include - y :: a (bound at PushedInAsGivens.hs:9:5) - bar :: a -> (a, Int) (bound at PushedInAsGivens.hs:9:1) + y :: a0 (bound at PushedInAsGivens.hs:9:5) + bar :: a0 -> (a0, Int) (bound at PushedInAsGivens.hs:9:1) ===================================== testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr ===================================== @@ -1,12 +1,13 @@ ExtraTcsUntch.hs:23:18: error: - • Couldn't match expected type ‘F Int’ with actual type ‘[p]’ + • Couldn't match expected type ‘F Int’ with actual type ‘[p0]’ + The type variable ‘p0’ is ambiguous • In the first argument of ‘h’, namely ‘[x]’ In the expression: h [x] In an equation for ‘g1’: g1 _ = h [x] • Relevant bindings include - x :: p (bound at ExtraTcsUntch.hs:21:3) - f :: p -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1) + x :: p0 (bound at ExtraTcsUntch.hs:21:3) + f :: p0 -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1) ExtraTcsUntch.hs:25:38: error: • Couldn't match expected type ‘F Int’ with actual type ‘[[a0]]’ ===================================== testsuite/tests/indexed-types/should_fail/T13972.hs ===================================== @@ -8,7 +8,7 @@ import Data.Kind class C (a :: k) where type T k :: Type --- This used to fail, with a mysterious error messate +-- This used to fail, with a mysterious error message -- Type indexes must match class instance head -- Expected: T (a1 -> Either a1 b1) -- Actual: T (a -> Either a b) ===================================== testsuite/tests/indexed-types/should_fail/T14230a.stderr ===================================== @@ -1,6 +1,7 @@ -T14230a.hs:13:14: error: - • Expected kind ‘k -> *’, but ‘a’ has kind ‘*’ - • In the second argument of ‘CD’, namely ‘(a :: k -> *)’ - In the data instance declaration for ‘CD’ +T14230a.hs:13:3: error: + • Type indexes must match class instance head + Expected: CD (*) (Maybe a) + Actual: CD k a + • In the data instance declaration for ‘CD’ In the instance declaration for ‘C (Maybe a)’ ===================================== testsuite/tests/partial-sigs/should_fail/NamedWildcardExplicitForall.stderr ===================================== @@ -17,23 +17,11 @@ NamedWildcardExplicitForall.hs:10:8: error: To use the inferred type, enable PartialTypeSignatures • In the type signature: bar :: _a -> _a -NamedWildcardExplicitForall.hs:13:26: error: - • Found type wildcard ‘_b’ standing for ‘Bool’ - To use the inferred type, enable PartialTypeSignatures - • In the type signature: baz :: forall _a. _a -> _b -> (_a, _b) - -NamedWildcardExplicitForall.hs:14:16: error: - • Couldn't match expected type ‘Bool’ with actual type ‘_a’ - ‘_a’ is a rigid type variable bound by - the inferred type of baz :: _a -> Bool -> (_a, Bool) - at NamedWildcardExplicitForall.hs:13:15-16 - • In the first argument of ‘not’, namely ‘x’ - In the expression: not x - In the expression: (not x, not y) - • Relevant bindings include - x :: _a (bound at NamedWildcardExplicitForall.hs:14:5) - baz :: _a -> Bool -> (_a, Bool) - (bound at NamedWildcardExplicitForall.hs:14:1) +NamedWildcardExplicitForall.hs:14:1: error: + Can't quantify over ‘_a’ + bound by the partial type signature: + baz :: forall _a. _a -> _b -> (_a, _b) + ‘_a’ should really be ‘Bool’ NamedWildcardExplicitForall.hs:16:8: error: • Found type wildcard ‘_a’ standing for ‘Bool’ ===================================== testsuite/tests/polykinds/T14172.stderr ===================================== @@ -24,15 +24,3 @@ T14172.hs:7:19: error: • Relevant bindings include traverseCompose :: (a -> f b) -> g a -> f (h a') (bound at T14172.hs:7:1) - -T14172.hs:7:19: error: - • Couldn't match type ‘Compose f'0 g'1 a'0 -> f (h a')’ - with ‘g a -> f (h a')’ - Expected type: (a -> f b) -> g a -> f (h a') - Actual type: (a -> f b) -> Compose f'0 g'1 a'0 -> f (h a') - • In the expression: _Wrapping Compose . traverse - In an equation for ‘traverseCompose’: - traverseCompose = _Wrapping Compose . traverse - • Relevant bindings include - traverseCompose :: (a -> f b) -> g a -> f (h a') - (bound at T14172.hs:7:1) ===================================== testsuite/tests/th/T11452.stderr ===================================== @@ -9,7 +9,6 @@ T11452.hs:6:12: error: T11452.hs:6:14: error: • Cannot instantiate unification variable ‘p0’ with a type involving polytypes: forall a. a -> a - GHC doesn't yet support impredicative polymorphism • In the Template Haskell quotation [|| \ _ -> () ||] In the expression: [|| \ _ -> () ||] In the Template Haskell splice $$([|| \ _ -> () ||]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f550eed809836699a98f67220baaf980bc08dcb9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f550eed809836699a98f67220baaf980bc08dcb9 You're receiving 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 18 22:13:31 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Fri, 18 Sep 2020 18:13:31 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] Remove abominable tcRemoveDataFamConPlaceholders Message-ID: <5f65310b2e678_80b3f846918995813154157@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: 684c39f9 by Adam Gundry at 2020-09-18T23:12:17+01:00 Remove abominable tcRemoveDataFamConPlaceholders - - - - - 5 changed files: - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Instance.hs-boot - compiler/GHC/Tc/TyCl/Utils.hs Changes: ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -100,6 +100,7 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType import GHC.Tc.Solver import GHC.Tc.TyCl +import GHC.Tc.TyCl.Utils ( tcRecSelBinds ) import GHC.Tc.Instance.Typeable ( mkTypeableBinds ) import GHC.Tc.Utils.Backpack import GHC.Iface.Load @@ -653,10 +654,16 @@ tcRnHsBootDecls hsc_src decls -- Typecheck type/class/instance decls ; traceTc "Tc2 (boot)" empty - ; (tcg_env, inst_infos, _deriv_binds) + ; (tcg_env, inst_infos, _deriv_binds, rec_sel_upd_binds) <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { + -- Record selectors and updaters + -- See Note [Calling tcRecSelBinds] in GHC.Tc.TyCl.Utils + traceTc "Tc3a" empty ; + tcg_env <- tcRecSelBinds rec_sel_upd_binds ; + setGblEnv tcg_env $ do { + -- Emit Typeable bindings ; tcg_env <- mkTypeableBinds ; setGblEnv tcg_env $ do { @@ -680,7 +687,7 @@ tcRnHsBootDecls hsc_src decls } ; setGlobalTypeEnv gbl_env type_env2 - }}} + }}}} ; traceTc "boot" (ppr lie); return gbl_env } badBootDecl :: HscSource -> String -> Located decl -> TcM () @@ -1412,11 +1419,18 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, -- Source-language instances, including derivings, -- and import the supporting declarations traceTc "Tc3" empty ; - (tcg_env, inst_infos, XValBindsLR (NValBinds deriv_binds deriv_sigs)) + (tcg_env, inst_infos, XValBindsLR (NValBinds deriv_binds deriv_sigs) + , rec_sel_upd_binds) <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ; setGblEnv tcg_env $ do { + -- Record selectors and updaters + -- See Note [Calling tcRecSelBinds] in GHC.Tc.TyCl.Utils + traceTc "Tc3a" empty ; + tcg_env <- tcRecSelBinds rec_sel_upd_binds ; + setGblEnv tcg_env $ do { + -- Generate Applicative/Monad proposal (AMP) warnings traceTc "Tc3b" empty ; @@ -1493,7 +1507,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, addUsedGREs (bagToList fo_gres) ; return (tcg_env', tcl_env) - }}}}}} + }}}}}}} tcTopSrcDecls _ = panic "tcTopSrcDecls: ValBindsIn" @@ -1689,13 +1703,14 @@ tcTyClsInstDecls :: [TyClGroup GhcRn] [InstInfo GhcRn], -- Source-code instance decls to -- process; contains all dfuns for -- this module - HsValBinds GhcRn) -- Supporting bindings for derived + HsValBinds GhcRn, -- Supporting bindings for derived -- instances + [(Id, LHsBind GhcRn)]) -- Record selector/updater bindings tcTyClsInstDecls tycl_decls deriv_decls binds = tcAddDataFamConPlaceholders (tycl_decls >>= group_instds) $ tcAddPatSynPlaceholders (getPatSynBinds binds) $ - do { (tcg_env, inst_info, deriv_info) + do { (tcg_env, inst_info, deriv_info, rec_sel_upd_binds) <- tcTyAndClassDecls tycl_decls ; ; setGblEnv tcg_env $ do { -- With the @TyClDecl at s and @InstDecl at s checked we're ready to @@ -1709,7 +1724,7 @@ tcTyClsInstDecls tycl_decls deriv_decls binds <- tcInstDeclsDeriv deriv_info deriv_decls ; setGblEnv tcg_env' $ do { failIfErrsM - ; pure (tcg_env', inst_info' ++ inst_info, val_binds) + ; pure (tcg_env', inst_info' ++ inst_info, val_binds, rec_sel_upd_binds) }}} {- ********************************************************************* ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -130,31 +130,34 @@ tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in -- and their implicit Ids,DataCons , [InstInfo GhcRn] -- Source-code instance decls info , [DerivInfo] -- Deriving info + , [(Id, LHsBind GhcRn)] -- Record selector/updater bindings ) -- Fails if there are any errors tcTyAndClassDecls tyclds_s -- The code recovers internally, but if anything gave rise to -- an error we'd better stop now, to avoid a cascade -- Type check each group in dependency order folding the global env - = checkNoErrs $ fold_env [] [] tyclds_s + = checkNoErrs $ fold_env [] [] [] tyclds_s where fold_env :: [InstInfo GhcRn] -> [DerivInfo] + -> [(Id, LHsBind GhcRn)] -> [TyClGroup GhcRn] - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) - fold_env inst_info deriv_info [] + -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], [(Id, LHsBind GhcRn)]) + fold_env inst_info deriv_info rec_sel_upd_binds [] = do { gbl_env <- getGblEnv - ; return (gbl_env, inst_info, deriv_info) } - fold_env inst_info deriv_info (tyclds:tyclds_s) - = do { (tcg_env, inst_info', deriv_info') <- tcTyClGroup tyclds + ; return (gbl_env, inst_info, deriv_info, rec_sel_upd_binds) } + fold_env inst_info deriv_info rec_sel_upd_binds (tyclds:tyclds_s) + = do { (tcg_env, inst_info', deriv_info', rec_sel_upd_binds') <- tcTyClGroup tyclds ; setGblEnv tcg_env $ -- remaining groups are typechecked in the extended global env. fold_env (inst_info' ++ inst_info) (deriv_info' ++ deriv_info) + (rec_sel_upd_binds' ++ rec_sel_upd_binds) tyclds_s } tcTyClGroup :: TyClGroup GhcRn - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) + -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], [(Id, LHsBind GhcRn)]) -- Typecheck one strongly-connected component of type, class, and instance decls -- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls tcTyClGroup (TyClGroup { group_tyclds = tyclds @@ -195,12 +198,16 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; gbl_env <- addTyConsToGblEnv tyclss -- Step 4: check instance declarations - ; (gbl_env', inst_info, datafam_deriv_info) <- + ; (gbl_env', inst_info, datafam_deriv_info, data_rep_tycons) <- setGblEnv gbl_env $ tcInstDecls1 instds + -- Step 5: build record selectors/updaters, don't type-check them yet + -- See Note [Calling tcRecSelBinds] in GHC.Tc.TyCl.Utils + ; rec_sel_upd_binds <- mkRecSelBinds (tyclss ++ data_rep_tycons) + ; let deriv_info = datafam_deriv_info ++ data_deriv_info - ; return (gbl_env', inst_info, deriv_info) } + ; return (gbl_env', inst_info, deriv_info, rec_sel_upd_binds) } -- Gives the kind for every TyCon that has a standalone kind signature type KindSigEnv = NameEnv Kind ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -382,7 +382,8 @@ tcInstDecls1 -- Deal with both source-code and imported instance decls -> TcM (TcGblEnv, -- The full inst env [InstInfo GhcRn], -- Source-code instance decls to process; -- contains all dfuns for this module - [DerivInfo]) -- From data family instances + [DerivInfo], -- From data family instances + [TyCon]) -- Data family instance representation tycons tcInstDecls1 inst_decls = do { -- Do class and family instance declarations @@ -392,13 +393,14 @@ tcInstDecls1 inst_decls fam_insts = concat fam_insts_s local_infos = concat local_infos_s - ; gbl_env <- addClsInsts local_infos $ + ; (data_rep_tycons, gbl_env) <- addClsInsts local_infos $ addFamInsts fam_insts $ getGblEnv ; return ( gbl_env , local_infos - , concat datafam_deriv_infos ) } + , concat datafam_deriv_infos + , data_rep_tycons ) } -- | Use DerivInfo for data family instances (produced by tcInstDecls1), -- datatype declarations (TyClDecl), and standalone deriving declarations @@ -419,9 +421,10 @@ addClsInsts :: [InstInfo GhcRn] -> TcM a -> TcM a addClsInsts infos thing_inside = tcExtendLocalInstEnv (map iSpec infos) thing_inside -addFamInsts :: [FamInst] -> TcM a -> TcM a +addFamInsts :: [FamInst] -> TcM a -> TcM ([TyCon], a) -- Extend (a) the family instance envt -- (b) the type envt with stuff from data type decls +-- Additionally return the data family representation tycons addFamInsts fam_insts thing_inside = tcExtendLocalFamInstEnv fam_insts $ tcExtendGlobalEnv axioms $ @@ -429,7 +432,8 @@ addFamInsts fam_insts thing_inside ; gbl_env <- addTyConsToGblEnv data_rep_tycons -- Does not add its axiom; that comes -- from adding the 'axioms' above - ; setGblEnv gbl_env thing_inside } + ; x <- setGblEnv gbl_env thing_inside + ; return (data_rep_tycons, x) } where axioms = map (ACoAxiom . toBranchedAxiom . famInstAxiom) fam_insts data_rep_tycons = famInstsRepTyCons fam_insts ===================================== compiler/GHC/Tc/TyCl/Instance.hs-boot ===================================== @@ -5,6 +5,7 @@ module GHC.Tc.TyCl.Instance ( tcInstDecls1 ) where +import GHC.Core.TyCon import GHC.Hs import GHC.Tc.Types import GHC.Tc.Utils.Env( InstInfo ) @@ -13,4 +14,4 @@ import GHC.Tc.Deriv -- We need this because of the mutual recursion -- between GHC.Tc.TyCl and GHC.Tc.TyCl.Instance tcInstDecls1 :: [LInstDecl GhcRn] - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo]) + -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], [TyCon]) ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -763,9 +763,7 @@ addTyConsToGblEnv tyclss do { traceTc "tcAddTyCons" $ vcat [ text "tycons" <+> ppr tyclss , text "implicits" <+> ppr implicit_things ] - ; gbl_env <- tcRemoveDataFamConPlaceholders tyclss $ - tcRecSelBinds =<< mkRecSelBinds tyclss - ; return gbl_env } + ; getGblEnv } where implicit_things = concatMap implicitTyConThings tyclss def_meth_ids = mkDefaultMethodIds tyclss @@ -1390,30 +1388,15 @@ exists, we do not currently solve HasField constraints for fields defined by pattern synonyms. And since we do not need updaters for anything other than solving HasField constraints, we do not generate them for pattern synonyms. --} - - -tcRemoveDataFamConPlaceholders :: [TyCon] -> TcM a -> TcM a --- ^ Remove the placeholders added by tcAddDataFamConPlaceholders --- See Note [tcRemoveDataFamConPlaceholders] -tcRemoveDataFamConPlaceholders tycons = updLclEnv upd_env - where - upd_env env = env { tcl_env = delListFromNameEnv (tcl_env env) cons } - - cons = [ dataConName data_con - | tycon <- tycons - , isFamInstTyCon tycon - , data_con <- tyConDataCons tycon - ] -{- -Note [tcRemoveDataFamConPlaceholders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Calling tcRecSelBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When type-checking record update bindings, we need to be able to look up the data constructors for the corresponding datatypes, because the constructors are used in the definitions. However, for data constructors in data family -instances the tcl_env contains placeholder bindings added to prevent the use of -promotion (see Note [AFamDataCon: not promoting data family constructors] in -GHC.Tc.Utils.Env). Thus we must remove them again before the call to -tcRecSelBinds in addTyConsToGblEnv. +instances, tcTyClsInstDecls adds placeholder bindings added to prevent the use +of promotion (see Note [AFamDataCon: not promoting data family constructors] in +GHC.Tc.Utils.Env). Thus we cannot call tcReclSelBinds in addTyConsToGblEnv, but +instead have to wait until tcTyClsInstDecls has completed. + -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/684c39f92e7b382de8ac9906ac16a152bb5f1f0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/684c39f92e7b382de8ac9906ac16a152bb5f1f0e You're receiving 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 19 00:02:36 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 18 Sep 2020 20:02:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18714-T18715 Message-ID: <5f654a9cd51bf_80b3f849a28761c131663c@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18714-T18715 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18714-T18715 You're receiving 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 19 00:49:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 20:49:11 -0400 Subject: [Git][ghc/ghc][wip/tsan/all] CI Message-ID: <5f65558772b5c_80b3f849581b5101317144e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tsan/all at Glasgow Haskell Compiler / GHC Commits: 333cfba4 by GHC GitLab CI at 2020-09-19T00:49:03+00:00 CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -636,12 +636,21 @@ nightly-x86_64-linux-deb9-integer-simple: TEST_ENV: "x86_64-linux-deb9-integer-simple" TEST_TYPE: slowtest -nightly-x86_64-linux-deb9-tsan: - extends: .build-x86_64-linux-deb9 +.build-x86_64-linux-deb9-tsan: + extends: .validate-linux-hadrian stage: full-build variables: TEST_ENV: "x86_64-linux-deb9-tsan" - FLAVOUR: "thread-sanitizer" + BUILD_FLAVOUR: "thread-sanitizer" + TSAN_OPTIONS: "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + +nightly-x86_64-linux-deb9-tsan: + <<: *nightly + extends: .build-x86_64-linux-deb9-tsan + +validate-x86_64-linux-deb9-tsan: + extends: .build-x86_64-linux-deb9-tsan + when: manual validate-x86_64-linux-deb9-dwarf: extends: .build-x86_64-linux-deb9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/333cfba4bc10804c99557a5324ea51e6d21694cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/333cfba4bc10804c99557a5324ea51e6d21694cb You're receiving 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 19 02:02:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 22:02:18 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f6566aae8c14_80bd33484013178563@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 Sat Sep 19 02:02:20 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 18 Sep 2020 22:02:20 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 4 commits: rts: Drop field initializer on thread_basic_info_data_t Message-ID: <5f6566acb11ad_80b8350540131787cb@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 4ffa7d40 by Ben Gamari at 2020-09-18T08:31:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. (cherry picked from commit 09b91e8b95eb16fe72aef8405896fd6caf789f61) - - - - - e5f6188b by Zubin Duggal at 2020-09-18T08:32:37-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - d16223fd by Alan Zimmerman at 2020-09-18T08:38:16-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) (cherry picked from commit 701463ec9998c679b03dcc848912a7ce9da9a66a) - - - - - 23f34f7b by Alan Zimmerman at 2020-09-18T08:38:29-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features (cherry picked from commit 0f4d29cac3826392ceb26ea219fce6e8a7505107) - - - - - 6 changed files: - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - rts/posix/GetTime.c - testsuite/tests/ghc-api/annotations/Makefile - testsuite/tests/ghc-api/annotations/T10358.stdout Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Driver.Types import GHC.Unit.Module ( ModuleName, ml_hs_file ) import GHC.Utils.Monad ( concatMapM, liftIO ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique ) +import GHC.Types.Name ( Name, nameSrcSpan, nameUnique ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) @@ -52,7 +52,7 @@ import GHC.Core.InstEnv import GHC.Builtin.Types ( mkListTy, mkSumTy ) import GHC.Tc.Types import GHC.Tc.Types.Evidence -import GHC.Types.Var ( Id, Var, EvId, setVarName, varName, varType, varUnique ) +import GHC.Types.Var ( Id, Var, EvId, varName, setVarName, varType, varUnique ) import GHC.Types.Var.Env import GHC.Types.Unique import GHC.Iface.Make ( mkIfaceExports ) @@ -1274,26 +1274,22 @@ instance ( ToHie (RFContext (Located label)) , toHie expr ] -removeDefSrcSpan :: Name -> Name -removeDefSrcSpan n = setNameLoc n noSrcSpan - instance ToHie (RFContext (LFieldOcc GhcRn)) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name) + [ toHie $ C (RecField c rhs) (L nspan name) ] instance ToHie (RFContext (LFieldOcc GhcTc)) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous name _ -> - [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name + [ toHie $ C (RecField c rhs) $ L nspan name ] Ambiguous _name _ -> [ ] @@ -1301,13 +1297,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] Ambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM ===================================== compiler/GHC/Parser.y ===================================== @@ -1961,7 +1961,7 @@ type :: { LHsType GhcPs } | btype '#->' ctype {% hintLinear (getLoc $2) >> ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3) - [mu AnnRarrow $2] } + [mu AnnLolly $2] } mult :: { LHsType GhcPs } : btype { $1 } @@ -2080,10 +2080,10 @@ tv_bndrs :: { [LHsTyVarBndr Specificity GhcPs] } tv_bndr :: { LHsTyVarBndr Specificity GhcPs } : tv_bndr_no_braces { $1 } | '{' tyvar '}' {% ams (sLL $1 $> (UserTyVar noExtField InferredSpec $2)) - [mop $1, mcp $3] } + [moc $1, mcc $3] } | '{' tyvar '::' kind '}' {% ams (sLL $1 $> (KindedTyVar noExtField InferredSpec $2 $4)) - [mop $1,mu AnnDcolon $3 - ,mcp $5] } + [moc $1,mu AnnDcolon $3 + ,mcc $5] } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } : tyvar { sL1 $1 (UserTyVar noExtField SpecifiedSpec $1) } @@ -3717,6 +3717,7 @@ isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITlolly iu)) = iu == UnicodeSyntax isUnicode _ = False hasE :: Located Token -> Bool ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1231,13 +1231,14 @@ makeFunBind fn ms checkPatBind :: LPat GhcPs -> Located (a,GRHSs GhcPs (LHsExpr GhcPs)) -> P ([AddAnn],HsBind GhcPs) -checkPatBind lhs (L match_span (_,grhss)) +checkPatBind lhs (L rhs_span (_,grhss)) | BangPat _ p <- unLoc lhs , VarPat _ v <- unLoc p = return ([], makeFunBind v [L match_span (m v)]) where + match_span = combineSrcSpans (getLoc lhs) rhs_span m v = Match { m_ext = noExtField - , m_ctxt = FunRhs { mc_fun = L (getLoc lhs) (unLoc v) + , m_ctxt = FunRhs { mc_fun = v , mc_fixity = Prefix , mc_strictness = SrcStrict } , m_pats = [] ===================================== rts/posix/GetTime.c ===================================== @@ -71,7 +71,7 @@ Time getCurrentThreadCPUTime(void) // support clock_getcpuclockid. Hence we prefer to use the Darwin-specific // path on Darwin, even if clock_gettime is available. #if defined(darwin_HOST_OS) - thread_basic_info_data_t info = { 0 }; + thread_basic_info_data_t info = { }; mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT; kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO, (thread_info_t) &info, &info_count); ===================================== testsuite/tests/ghc-api/annotations/Makefile ===================================== @@ -39,7 +39,8 @@ listcomps: .PHONY: T10358 T10358: - $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs + # Ignore result code, we have an unattached (superfluous) AnnBang + - $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs .PHONY: T10396 T10396: ===================================== testsuite/tests/ghc-api/annotations/T10358.stdout ===================================== @@ -1,5 +1,5 @@ ---Unattached Annotation Problems (should be empty list)--- -[] +[(AnnBang, Test10358.hs:5:19)] ---Ann before enclosing span problem (should be empty list)--- [ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e00ee7b9c1da4ee687673309a154c9718437473...23f34f7be335f94dcebb7459008d4b1cfa926e3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e00ee7b9c1da4ee687673309a154c9718437473...23f34f7be335f94dcebb7459008d4b1cfa926e3e You're receiving 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 19 10:57:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 06:57:43 -0400 Subject: [Git][ghc/ghc][master] Deprecate Data.Semigroup.Option Message-ID: <5f65e4274a8ad_80b3f849a401df81319895e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 3 changed files: - libraries/base/Data/Semigroup.hs - libraries/base/changelog.md - libraries/deepseq Changes: ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -347,8 +347,6 @@ instance Bifoldable Arg where instance Bitraversable Arg where bitraverse f g (Arg a b) = Arg <$> f a <*> g b --- | Use @'Option' ('First' a)@ to get the behavior of --- 'Data.Monoid.First' from "Data.Monoid". newtype First a = First { getFirst :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0 @@ -405,8 +403,6 @@ instance Monad First where instance MonadFix First where mfix f = fix (f . getFirst) --- | Use @'Option' ('Last' a)@ to get the behavior of --- 'Data.Monoid.Last' from "Data.Monoid" newtype Last a = Last { getLast :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0 @@ -511,6 +507,8 @@ mtimesDefault n x | n == 0 = mempty | otherwise = unwrapMonoid (stimes n (WrapMonoid x)) +{-# DEPRECATED Option, option "will be removed in GHC 9.2; use 'Maybe' instead." #-} + -- | 'Option' is effectively 'Maybe' with a better instance of -- 'Monoid', built off of an underlying 'Semigroup' instead of an -- underlying 'Monoid'. @@ -520,8 +518,7 @@ mtimesDefault n x -- -- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been -- corrected to lift a 'Semigroup' instance instead of a 'Monoid' --- instance. Consequently, this type is no longer useful. It will be --- marked deprecated in GHC 8.8 and removed in GHC 8.10. +-- instance. Consequently, this type is no longer useful. newtype Option a = Option { getOption :: Maybe a } deriving ( Eq -- ^ @since 4.9.0.0 , Ord -- ^ @since 4.9.0.0 ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,9 @@ * The planned deprecation of `Data.Monoid.First` and `Data.Monoid.Last` is scrapped due to difficulties with the suggested migration path. + * `Data.Semigroup.Option` and the accompanying `option` function are + deprecated and scheduled for removal in 4.16. + * Add `Generic` instances to `Fingerprint`, `GiveGCStats`, `GCFlags`, `ConcFlags`, `DebugFlags`, `CCFlags`, `DoHeapProfile`, `ProfFlags`, `DoTrace`, `TraceFlags`, `TickyFlags`, `ParFlags`, `RTSFlags`, `RTSStats`, ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit 13c1c84415da727ab56e9fa33aca5046b6683848 +Subproject commit b8c4fb4debaed6ef7eb6940ca4cfea6bd63cc212 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45fa82182bc61e3966fd51496c35130cd067a5df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45fa82182bc61e3966fd51496c35130cd067a5df You're receiving 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 19 13:07:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 09:07:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Deprecate Data.Semigroup.Option Message-ID: <5f66028dd1ff0_80b3f849247243413211884@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 4d2c8d0b by Vladislav Zavialov at 2020-09-19T09:07:05-04:00 Require happy >=1.20 - - - - - eaac97a4 by Ben Gamari at 2020-09-19T09:07:05-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - ec6cf027 by Ben Gamari at 2020-09-19T09:07:05-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - 49e0f464 by Ryan Scott at 2020-09-19T09:07:06-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 ------------------------- - - - - - c95e7f10 by Wander Hillen at 2020-09-19T09:07:08-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - d8abf23b by Sylvain Henry at 2020-09-19T09:07:12-04:00 Bump Stack resolver - - - - - d4cfe3e1 by John Ericson at 2020-09-19T09:07:13-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - 6e594dbe by Sylvain Henry at 2020-09-19T09:07:13-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 0981cb20 by Andreas Klebinger at 2020-09-19T09:07:13-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - c3fb07f7 by Andreas Klebinger at 2020-09-19T09:07:13-04:00 Fix a codeblock in ghci.rst - - - - - 0f0db407 by Ben Gamari at 2020-09-19T09:07:14-04:00 users guide: Fix various documentation issues - - - - - a3f5cf7c by Ben Gamari at 2020-09-19T09:07:14-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - c1b14ec4 by David Feuer at 2020-09-19T09:07:16-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 05a765b3 by Artyom Kuznetsov at 2020-09-19T09:07:18-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - cfde7611 by Ben Gamari at 2020-09-19T09:07:18-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 30 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Misc.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 - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/ghc-bin.cabal.in - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11c0c3338045c56eea668631db956a728168463e...cfde7611fc5f34c35377c6f48d6b6fe904fb62d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11c0c3338045c56eea668631db956a728168463e...cfde7611fc5f34c35377c6f48d6b6fe904fb62d2 You're receiving 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 19 19:47:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:47:30 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Require happy >=1.20 Message-ID: <5f6660525fc7b_80b3f8450df647013233118@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - 4 changed files: - .gitlab/ci.sh - aclocal.m4 - hadrian/cabal.project - hadrian/hadrian.cabal Changes: ===================================== .gitlab/ci.sh ===================================== @@ -6,7 +6,9 @@ set -e -o pipefail # Configuration: -hackage_index_state="@1579718451" +hackage_index_state="2020-09-14T19:30:43Z" +MIN_HAPPY_VERSION="1.20" +MIN_ALEX_VERSION="3.2" # Colors BLACK="0;30" @@ -286,7 +288,9 @@ function setup_toolchain() { cabal_install="$CABAL v2-install \ --with-compiler=$GHC \ - --index-state=$hackage_index_state --installdir=$toolchain/bin" + --index-state=$hackage_index_state \ + --installdir=$toolchain/bin \ + --overwrite-policy=always" # Avoid symlinks on Windows case "$(uname)" in @@ -294,17 +298,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() { ===================================== aclocal.m4 ===================================== @@ -1063,8 +1063,8 @@ changequote([, ])dnl ]) 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],[-lt],[1.20.0], + [AC_MSG_ERROR([Happy version 1.20 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 ===================================== hadrian/cabal.project ===================================== @@ -1,7 +1,7 @@ packages: ./ -- This essentially freezes the build plan for hadrian -index-state: 2020-06-16T03:59:14Z +index-state: 2020-09-14T19:30:43Z -- N.B. Compile with -O0 since this is not a performance-critical executable -- and the Cabal takes nearly twice as long to build with -O1. See #16817. ===================================== 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 && < 1.21 + , happy >= 1.20.0 && < 1.21 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45fa82182bc61e3966fd51496c35130cd067a5df...2f7ef2fb3234cdfb89b3da1298fc9c1b7381e418 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45fa82182bc61e3966fd51496c35130cd067a5df...2f7ef2fb3234cdfb89b3da1298fc9c1b7381e418 You're receiving 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 19 19:48:12 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:48:12 -0400 Subject: [Git][ghc/ghc][master] Wire in constraint tuples Message-ID: <5f66607ccf608_80b3f849c3acf0413240232@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 - compiler/GHC/Types/Basic.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,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 ===================================== @@ -1207,10 +1207,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 ===================================== @@ -182,7 +182,7 @@ type JoinArity = Int ************************************************************************ -} --- | Constructor Tag +-- | A *one-index* constructor tag -- -- Type of the tags associated with each constructor possibility or superclass -- selector View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac213d267140e747a391f68bc9f060e117395547 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac213d267140e747a391f68bc9f060e117395547 You're receiving 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 19 19:49:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:49:24 -0400 Subject: [Git][ghc/ghc][master] Bump Stack resolver Message-ID: <5f6660c46ad4_80b3f848698d3e413243784@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - 3 changed files: - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/stack.yaml Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -144,7 +144,7 @@ executable hadrian , filepath , mtl == 2.2.* , parsec >= 3.1 && < 3.2 - , shake >= 0.18.3 && < 0.18.6 + , shake >= 0.18.3 && < 0.20 , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 ===================================== hadrian/src/Base.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Base ( -- * General utilities module Control.Applicative, @@ -34,7 +36,11 @@ import Control.Monad.Reader import Data.List.Extra import Data.Maybe import Data.Semigroup +#if MIN_VERSION_shake(0,19,0) +import Development.Shake hiding (unit, Normal) +#else import Development.Shake hiding (unit, (*>), Normal) +#endif import Development.Shake.Classes import Development.Shake.FilePath import Development.Shake.Util ===================================== hadrian/stack.yaml ===================================== @@ -1,4 +1,4 @@ -resolver: lts-15.5 +resolver: lts-16.14 packages: - '.' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c1b8ad931e7bfabe521bc17e74ac9869b21a748 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c1b8ad931e7bfabe521bc17e74ac9869b21a748 You're receiving 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 19 19:48:48 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:48:48 -0400 Subject: [Git][ghc/ghc][master] Export singleton function from Data.List Message-ID: <5f6660a051f4_80b3f84862de6381324186b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 8 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Misc.hs - libraries/base/Data/List.hs Changes: ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -71,7 +71,7 @@ import GHC.Driver.Types import GHC.Core.Class import GHC.Core.TyCon import GHC.Types.Unique.FM -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Utils.Panic import GHC.Builtin.Types.Literals ( typeNatTyCons ) import GHC.Hs.Doc @@ -180,7 +180,7 @@ knownKeyNamesOkay all_names | otherwise = Just badNamesStr where - namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n) + namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) Utils.singleton m n n) emptyUFM all_names badNamesEnv = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv badNamesPairs = nonDetUFMToList badNamesEnv ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -67,7 +67,7 @@ import GHC.Utils.Panic import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.Bag -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import Data.List import Data.Function ( on ) import Control.Monad ( guard ) @@ -358,7 +358,7 @@ unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2 extendRuleBase :: RuleBase -> CoreRule -> RuleBase extendRuleBase rule_base rule - = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule + = extendNameEnv_Acc (:) Utils.singleton rule_base (ruleIdName rule) rule pprRuleBase :: RuleBase -> SDoc pprRuleBase rules = pprUFM rules $ \rss -> ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Data.Graph.Directed import GHC.Types.SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Types.Unique -import GHC.Utils.Misc hiding ( eqListBy ) +import GHC.Utils.Misc as Utils hiding ( eqListBy ) import GHC.Data.Maybe import GHC.Data.FastString import GHC.Utils.Binary @@ -1339,7 +1339,7 @@ mkOrphMap get_key decls where go (non_orphs, orphs) d | NotOrphan occ <- get_key d - = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs) + = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) | otherwise = (non_orphs, d:orphs) -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Utils.Outputable as Outputable import GHC.Data.Maybe import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Basic ( TopLevelFlag(..), StringLiteral(..) ) -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Utils.Panic import GHC.Data.FastString import GHC.Data.FastString.Env @@ -1186,8 +1186,8 @@ mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt] mkChildEnv gres = foldr add emptyNameEnv gres where add gre env = case gre_par gre of - FldParent p _ -> extendNameEnv_Acc (:) singleton env p gre - ParentIs p -> extendNameEnv_Acc (:) singleton env p gre + FldParent p _ -> extendNameEnv_Acc (:) Utils.singleton env p gre + ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre NoParent -> env findChildren :: NameEnv [a] -> Name -> [a] ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -55,7 +55,7 @@ import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SrcLoc -import GHC.Utils.Misc( singleton ) +import GHC.Utils.Misc as Utils ( singleton ) import GHC.Data.Maybe( orElse ) import Data.Maybe( mapMaybe ) import Control.Monad( unless ) @@ -554,7 +554,7 @@ lookupPragEnv :: TcPragEnv -> Name -> [LSig GhcRn] lookupPragEnv prag_fn n = lookupNameEnv prag_fn n `orElse` [] extendPragEnv :: TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv -extendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) singleton prag_fn n sig +extendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) Utils.singleton prag_fn n sig --------------- mkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -84,7 +84,7 @@ import GHC.Utils.Outputable import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Utils.Panic import GHC.Types.Name.Env @@ -970,7 +970,7 @@ mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv mkGlobalRdrEnv gres = foldr add emptyGlobalRdrEnv gres where - add gre env = extendOccEnv_Acc insertGRE singleton env + add gre env = extendOccEnv_Acc insertGRE Utils.singleton env (greOccName gre) gre @@ -1004,7 +1004,7 @@ transformGREs trans_gre occs rdr_env extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv extendGlobalRdrEnv env gre - = extendOccEnv_Acc insertGRE singleton env + = extendOccEnv_Acc insertGRE Utils.singleton env (greOccName gre) gre shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Utils.Misc ( listLengthCmp, atLength, equalLength, compareLength, leLength, ltLength, - isSingleton, only, singleton, + isSingleton, only, GHC.Utils.Misc.singleton, notNull, snocView, isIn, isn'tIn, ===================================== libraries/base/Data/List.hs ===================================== @@ -25,6 +25,7 @@ module Data.List , tail , init , uncons + , singleton , null , length View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e195dae6d959e2a9b1a22a2ca78db5955e1d7dea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e195dae6d959e2a9b1a22a2ca78db5955e1d7dea You're receiving 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 19 19:50:04 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:50:04 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Cinch -fno-warn-name-shadowing down to specific GHCi module Message-ID: <5f6660ec1826d_80b114a2d681324777e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 6 changed files: - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/ghc-bin.cabal.in - hadrian/src/Settings.hs - hadrian/src/Settings/Flavours/Quick.hs Changes: ===================================== ghc/GHCi/UI.hs ===================================== @@ -11,6 +11,9 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS -fno-warn-name-shadowing #-} +-- This module does a lot of it + ----------------------------------------------------------------------------- -- -- GHC Interactive User Interface ===================================== ghc/GHCi/UI/Info.hs ===================================== @@ -4,6 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -fno-warn-name-shadowing #-} + -- | Get information on modules, expressions, and identifiers module GHCi.UI.Info ( ModInfo(..) ===================================== ghc/GHCi/UI/Monad.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP, FlexibleInstances, DeriveFunctor, DerivingVia #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -65,7 +65,6 @@ Executable ghc exceptions == 0.10.*, time >= 1.8 && < 1.10 CPP-Options: -DHAVE_INTERNAL_INTERPRETER - GHC-Options: -fno-warn-name-shadowing Other-Modules: GHCi.Leak GHCi.UI ===================================== hadrian/src/Settings.hs ===================================== @@ -54,7 +54,8 @@ hadrianFlavours :: [Flavour] hadrianFlavours = [ benchmarkFlavour, defaultFlavour, developmentFlavour Stage1 , developmentFlavour Stage2, performanceFlavour, profiledFlavour - , quickFlavour, quickestFlavour, quickCrossFlavour, benchmarkLlvmFlavour + , quickFlavour, quickValidateFlavour, quickestFlavour + , quickCrossFlavour, benchmarkLlvmFlavour , performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour , ghcInGhciFlavour, validateFlavour, slowValidateFlavour ] ===================================== hadrian/src/Settings/Flavours/Quick.hs ===================================== @@ -1,4 +1,8 @@ -module Settings.Flavours.Quick (quickFlavour) where +module Settings.Flavours.Quick + ( quickFlavour + , quickValidateFlavour + ) +where import Expression import Flavour @@ -30,3 +34,8 @@ quickArgs = sourceArgs SourceArgs , hsLibrary = notStage0 ? arg "-O" , hsCompiler = stage0 ? arg "-O2" , hsGhc = stage0 ? arg "-O" } + +quickValidateFlavour :: Flavour +quickValidateFlavour = werror $ quickFlavour + { name = "quick-validate" + } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c1b8ad931e7bfabe521bc17e74ac9869b21a748...f1accd00969e0b2993f14ee4ed858cea0c13357e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c1b8ad931e7bfabe521bc17e74ac9869b21a748...f1accd00969e0b2993f14ee4ed858cea0c13357e You're receiving 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 19 19:50:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:50:38 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Fix docs who misstated how the RTS treats size suffixes. Message-ID: <5f66610eac422_80ba261e0c1324980@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 2 changed files: - docs/users_guide/ghci.rst - docs/users_guide/runtime_control.rst Changes: ===================================== docs/users_guide/ghci.rst ===================================== @@ -2564,6 +2564,7 @@ commonly used commands. be used. .. code-block:: none + ghci>:set -XDataKinds -XUndecidableInstances ghci>import GHC.TypeLits ghci>class A a ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -81,8 +81,8 @@ command line to go to the program (and not the RTS), use a the program, while ``--`` will. As always, for RTS options that take ⟨size⟩s: If the last character of -⟨size⟩ is a K or k, multiply by 1000; if an M or m, by 1,000,000; if a G -or G, by 1,000,000,000. (And any wraparound in the counters is *your* +⟨size⟩ is a K or k, multiply by 1024; if an M or m, by 1024*1024; if a G +or G, by 1024^3. (And any wraparound in the counters is *your* fault!) Giving a ``+RTS -?`` RTS option will print out the RTS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1accd00969e0b2993f14ee4ed858cea0c13357e...2ae0edbdfaf920d0c4da4edf721b947e11eb054c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1accd00969e0b2993f14ee4ed858cea0c13357e...2ae0edbdfaf920d0c4da4edf721b947e11eb054c You're receiving 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 19 19:51:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:51:15 -0400 Subject: [Git][ghc/ghc][master] 2 commits: users guide: Fix various documentation issues Message-ID: <5f6661335f05a_80b3f8492459fd81325296e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - 6 changed files: - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/instances.rst - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - hadrian/src/Rules/Documentation.hs Changes: ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -49,9 +49,10 @@ Highlights - 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 - not used anymore + + - gmp: adapted from integer-gmp package that was used before + - 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 ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -37,9 +37,9 @@ Notes: instance forall a. Eq a => Eq [a] where ... - Note that the use of ``forall``s in instance declarations is somewhat + Note that the use of ``forall``\s in instance declarations is somewhat restricted in comparison to other types. For example, instance declarations - are not allowed to contain nested ``forall``s. See + are not allowed to contain nested ``forall``\s. See :ref:`formal-instance-syntax` for more information. - If the :ghc-flag:`-Wunused-foralls` flag is enabled, a warning will be emitted ===================================== docs/users_guide/exts/instances.rst ===================================== @@ -141,22 +141,22 @@ Where: - ``btype`` is a type that is not allowed to have an outermost ``forall``/``=>`` unless it is surrounded by parentheses. For example, - ``forall a. a`` and ``Eq a => a`` are not legal ``btype``s, but + ``forall a. a`` and ``Eq a => a`` are not legal ``btype``\s, but ``(forall a. a)`` and ``(Eq a => a)`` are legal. - ``ctype`` is a ``btype`` that has no restrictions on an outermost - ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``s. -- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``s + ``forall``/``=>``, so ``forall a. a`` and ``Eq a => a`` are legal ``ctype``\s. +- ``arg_type`` is a type that is not allowed to have ``forall``s or ``=>``\s - ``prefix_cls_tycon`` is a class type constructor written prefix (e.g., ``Show`` or ``(&&&)``), while ``infix_cls_tycon`` is a class type constructor - written infix (e.g., ```Show``` or ``&&&``). + written infix (e.g., ``\`Show\``` or ``&&&``). This is a simplified grammar that does not fully delve into all of the implementation details of GHC's parser (such as the placement of Haddock comments), but it is sufficient to attain an understanding of what is syntactically allowed. Some further various observations about this grammar: -- Instance declarations are not allowed to be declared with nested ``forall``s - or ``=>``s. For example, this would be rejected: :: +- Instance declarations are not allowed to be declared with nested ``forall``\s + or ``=>``\s. For example, this would be rejected: :: instance forall a. forall b. C (Either a b) where ... ===================================== docs/users_guide/release-notes.rst ===================================== @@ -5,3 +5,4 @@ Release notes :maxdepth: 1 9.0.1-notes + 9.2.1-notes ===================================== docs/users_guide/runtime_control.rst ===================================== @@ -183,6 +183,13 @@ Event log output Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l ⟨flags⟩`) is written through a custom :c:type:`EventLogWriter`: +.. The size_t declaration below is simply to ensure that the build doesn't fail with an + undefined reference target warning as Sphinx doesn't know about size_t. + +.. c:type:: size_t + + :hidden: + .. c:type:: EventLogWriter A sink of event-log data. ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -127,6 +127,21 @@ checkSphinxWarnings :: FilePath -- ^ output directory -> Action () checkSphinxWarnings out = do log <- liftIO $ readFile (out -/- ".log") + when ("Inline literal start-string without end-string." `isInfixOf` log) + $ fail $ unlines + [ "Syntax error found in Sphinx log. " + , "" + , "This likely means that you have forgotten a \\ after inline code block. For instance," + , "you might have written:" + , "" + , " are not allowed to contain nested ``forall``s." + , "" + , "Whereas you need to write:" + , "" + , " are not allowed to contain nested ``forall``\\s." + , "" + ] + when ("reference target not found" `isInfixOf` log) $ fail "Undefined reference targets found in Sphinx log." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ae0edbdfaf920d0c4da4edf721b947e11eb054c...885ecd18e084e4e2b15fbc5de0aa5222f2573387 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ae0edbdfaf920d0c4da4edf721b947e11eb054c...885ecd18e084e4e2b15fbc5de0aa5222f2573387 You're receiving 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 19 19:51:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:51:49 -0400 Subject: [Git][ghc/ghc][master] Unpack the MVar in Compact Message-ID: <5f6661559ecc6_80b3f848b893b8c13255040@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 1 changed file: - libraries/ghc-compact/GHC/Compact.hs Changes: ===================================== libraries/ghc-compact/GHC/Compact.hs ===================================== @@ -136,7 +136,7 @@ import GHC.Types -- If compaction encounters any of the above, a 'Control.Exception.CompactionFailed' -- exception will be thrown by the compaction operation. -- -data Compact a = Compact Compact# a (MVar ()) +data Compact a = Compact Compact# a !(MVar ()) -- we can *read* from a Compact without taking a lock, but only -- one thread can be writing to the compact at any given time. -- The MVar here is to enforce mutual exclusion among writers. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b26cd86795d86850bfa97aa020d0a46b8ac043da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b26cd86795d86850bfa97aa020d0a46b8ac043da You're receiving 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 19 19:52:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:52:31 -0400 Subject: [Git][ghc/ghc][master] Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Message-ID: <5f66617f9b207_80b3f848b893b8c132602f0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 11 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/dependent/should_fail/T12174.hs → testsuite/tests/dependent/should_compile/T12174.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/dependent/should_fail/T12081.stderr - − testsuite/tests/dependent/should_fail/T12174.stderr - testsuite/tests/dependent/should_fail/all.T - testsuite/tests/polykinds/T11554.hs - − testsuite/tests/polykinds/T11554.stderr - testsuite/tests/polykinds/all.T - + testsuite/tests/typecheck/should_compile/T15942.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1798,11 +1798,9 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; case thing of ATyVar _ tv -> return (mkTyVarTy tv, tyVarKind tv) + -- See Note [Recursion through the kinds] ATcTyCon tc_tc - -> do { -- See Note [GADT kind self-reference] - unless (isTypeLevel (mode_tyki mode)) - (promotionErr name TyConPE) - ; check_tc tc_tc + -> do { check_tc tc_tc ; return (mkTyConTy tc_tc, tyConKind tc_tc) } AGlobal (ATyCon tc) @@ -1843,25 +1841,34 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon dc_theta_illegal_constraint = find (not . isEqPred) {- -Note [GADT kind self-reference] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -A promoted type cannot be used in the body of that type's declaration. -#11554 shows this example, which made GHC loop: +Note [Recursion through the kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider these examples - import Data.Kind +#11554: data P (x :: k) = Q data A :: Type where - B :: forall (a :: A). P a -> A + MkA :: forall (a :: A). P a -> A + +#12174 + data V a + data T = forall (a :: T). MkT (V a) + +The type is recursive (which is fine) but it is recursive /through the +kinds/. In earlier versions of GHC this caused a loop in the compiler +(to do with knot-tying) but there is nothing fundamentally wrong with +the code (kinds are types, and the recursive declarations are OK). But +it's hard to distinguish "recursion through the kinds" from "recursion +through the types". Consider this (also #11554): + + data PB k (x :: k) = Q + data B :: Type where + MkB :: P B a -> B -In order to check the constructor B, we need to have the promoted type A, but in -order to get that promoted type, B must first be checked. To prevent looping, a -TyConPE promotion error is given when tcTyVar checks an ATcTyCon in kind mode. -Any ATcTyCon is a TyCon being defined in the current recursive group (see data -type decl for TcTyThing), and all such TyCons are illegal in kinds. +Here the occurrence of B is not obviously in a kind position. -#11962 proposes checking the head of a data declaration separately from -its constructors. This would allow the example above to pass. +So now GHC allows all these programs. #12081 and #15942 are other +examples. Note [Body kind of a HsForAllTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/dependent/should_fail/T12174.hs → testsuite/tests/dependent/should_compile/T12174.hs ===================================== ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -67,3 +67,4 @@ test('T16391a', normal, compile, ['']) test('T16344b', normal, compile, ['']) test('T16347', normal, compile, ['']) test('T18660', normal, compile, ['']) +test('T12174', normal, compile, ['']) ===================================== testsuite/tests/dependent/should_fail/T12081.stderr ===================================== @@ -1,7 +1,6 @@ T12081.hs:9:14: error: - • Type constructor ‘T’ cannot be used here - (it is defined and used in the same recursive group) + • Expected a type, but ‘T n’ has kind ‘Nat’ • In the kind ‘T n’ In the type signature: f :: (a :: T n) In the class declaration for ‘C’ ===================================== testsuite/tests/dependent/should_fail/T12174.stderr deleted ===================================== @@ -1,7 +0,0 @@ - -T12174.hs:9:23: error: - • Type constructor ‘T’ cannot be used here - (it is defined and used in the same recursive group) - • In the kind ‘T’ - In the definition of data constructor ‘MkS’ - In the data declaration for ‘S’ ===================================== testsuite/tests/dependent/should_fail/all.T ===================================== @@ -13,7 +13,6 @@ test('T11407', normal, compile_fail, ['']) test('T11334b', normal, compile_fail, ['']) test('T11473', normal, compile_fail, ['']) test('T11471', normal, compile_fail, ['']) -test('T12174', normal, compile_fail, ['']) test('T12081', normal, compile_fail, ['']) test('T13135', normal, compile_fail, ['']) test('T13601', normal, compile_fail, ['']) ===================================== testsuite/tests/polykinds/T11554.hs ===================================== @@ -1,10 +1,17 @@ -{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-} +{-# LANGUAGE GADTs, PolyKinds, RankNTypes, TypeApplications, DataKinds #-} module T11554 where import Data.Kind -data P (x :: k) = Q +data P1 (x :: k) = Q1 +data A1 :: Type where + B1 :: forall (a :: A1). P1 a -> A1 -data A :: Type where - B :: forall (a :: A). P a -> A +data P2 k (x :: k) = Q2 +data A2 :: Type where + B2 :: P2 A2 a -> A2 + +data P3 (x :: k) = Q3 +data A3 :: Type where + B3 :: P3 @A3 a -> A3 ===================================== testsuite/tests/polykinds/T11554.stderr deleted ===================================== @@ -1,7 +0,0 @@ - -T11554.hs:10:21: error: - • Type constructor ‘A’ cannot be used here - (it is defined and used in the same recursive group) - • In the kind ‘A’ - In the definition of data constructor ‘B’ - In the data declaration for ‘A’ ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -148,7 +148,7 @@ test('KindVType', normal, compile_fail, ['']) test('T11821', normal, compile, ['']) test('T11821a', normal, compile_fail, ['']) test('T11640', normal, compile, ['']) -test('T11554', normal, compile_fail, ['']) +test('T11554', normal, compile, ['']) test('T12055', normal, compile, ['']) test('T12055a', normal, compile_fail, ['']) test('T12593', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T15942.hs ===================================== @@ -0,0 +1,28 @@ +{-# Language DataKinds #-} +{-# Language RankNTypes #-} +{-# Language TypeApplications #-} +{-# Language PolyKinds #-} +{-# Language KindSignatures #-} +{-# Language TypeFamilies #-} +{-# Language AllowAmbiguousTypes #-} +module T15942 where + +import Data.Kind +import Data.Proxy + +type G1 = forall (b :: Bool). Type + +data Fun1 :: G1 + +class F1 (bool :: Bool) where + type Not1 bool :: Bool + foo1 :: Fun1 @(Not1 bool) + +type G2 = Bool -> Type + +data Fun2 :: G2 + +class F2 (bool :: Bool) where + type Not2 bool :: Bool + foo2 :: Proxy (x :: Proxy (Not2 bool)) + ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -722,4 +722,5 @@ test('T18412', normal, compile, ['']) test('T18470', normal, compile, ['']) test('T18323', normal, compile, ['']) test('T18585', normal, compile, ['']) +test('T15942', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/760307cf5511d970dfddf7fa4b502b4e3394b197 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/760307cf5511d970dfddf7fa4b502b4e3394b197 You're receiving 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 19 19:53:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 19 Sep 2020 15:53:01 -0400 Subject: [Git][ghc/ghc][master] rts: Drop field initializer on thread_basic_info_data_t Message-ID: <5f66619d908ed_80b3f84a0317f68132626d9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 1 changed file: - rts/posix/GetTime.c Changes: ===================================== rts/posix/GetTime.c ===================================== @@ -71,7 +71,7 @@ Time getCurrentThreadCPUTime(void) // support clock_getcpuclockid. Hence we prefer to use the Darwin-specific // path on Darwin, even if clock_gettime is available. #if defined(darwin_HOST_OS) - thread_basic_info_data_t info = { 0 }; + thread_basic_info_data_t info = { }; mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT; kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO, (thread_info_t) &info, &info_count); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/057db94ce038970b14df1599fe83097c284b9c1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/057db94ce038970b14df1599fe83097c284b9c1f You're receiving 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 19 20:55:39 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 19 Sep 2020 16:55:39 -0400 Subject: [Git][ghc/ghc][wip/parsing-shift] 52 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f66704bcddb1_80b3f8494d192fc132727cd@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/parsing-shift at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b25cf155cd5132b686d882ba84e71108db3f0203...87e2e2b17afed82d30841d5b44c977123b93ecc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b25cf155cd5132b686d882ba84e71108db3f0203...87e2e2b17afed82d30841d5b44c977123b93ecc4 You're receiving 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 20 00:23:17 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sat, 19 Sep 2020 20:23:17 -0400 Subject: [Git][ghc/ghc][wip/T18599] add to testsuite Message-ID: <5f66a0f5bc085_80b3f8403e247b41327758e@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: bcde79d5 by Shayne Fletcher at 2020-09-19T20:22:58-04:00 add to testsuite - - - - - 8 changed files: - record-dot-syntax-tests/Construction.hs → testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - record-dot-syntax-tests/Pattern.hs → testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - testsuite/tests/parser/should_fail/all.T - record-dot-syntax-tests/Test.hs → testsuite/tests/parser/should_run/RecordDotSyntax.hs - + testsuite/tests/parser/should_run/RecordDotSyntax.stdout - testsuite/tests/parser/should_run/all.T Changes: ===================================== record-dot-syntax-tests/Construction.hs → testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.hs ===================================== ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -0,0 +1,5 @@ +ghc: panic! (the 'impossible' happened) + (GHC version 8.11.0.20200909: + fbindToRecField: The impossible happened + +Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ===================================== record-dot-syntax-tests/Pattern.hs → testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail1.hs:3:10: + Field selector syntax is not supported in patterns. ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -173,3 +173,5 @@ test('T18251c', normal, compile_fail, ['']) test('T18251d', normal, compile_fail, ['']) test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) +test('RecordDotSyntaxFail0', normal, compile_fail, ['']) +test('RecordDotSyntaxFail1', normal, compile_fail, ['']) ===================================== record-dot-syntax-tests/Test.hs → testsuite/tests/parser/should_run/RecordDotSyntax.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!; 42, 4 + print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.stdout ===================================== @@ -0,0 +1,36 @@ +-- selectors: +Bar {bar = Baz {baz = Quux {quux = 42}}} +Baz {baz = Quux {quux = 42}} +Quux {quux = 42} +42 +12 +12 +-- selections: +42 +Quux {quux = 42} +Baz {baz = Quux {quux = 42}} +Bar {bar = Baz {baz = Quux {quux = 42}}} +"hello" +"hello" +42 +42 +43 +43 +43 +-- updates: +Quux {quux = 2} +Bar {bar = Baz {baz = Quux {quux = 1}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} +Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} +-- punned updates: +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} +Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} +Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} +Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 1}}}}} +Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}} +Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} ===================================== testsuite/tests/parser/should_run/all.T ===================================== @@ -19,3 +19,4 @@ test('CountParserDeps', compile_and_run, ['-package ghc']) test('LexNegLit', normal, compile_and_run, ['']) +test('RecordDotSyntax', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcde79d54d20b95c4f16b05355e1f8c81359ee9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcde79d54d20b95c4f16b05355e1f8c81359ee9e You're receiving 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 20 11:45:39 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sun, 20 Sep 2020 07:45:39 -0400 Subject: [Git][ghc/ghc][wip/T18714-T18715] 21 commits: rts/nonmoving: Add missing STM write barrier Message-ID: <5f6740e34bd26_80b78d301813293394@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T18714-T18715 at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - b7e9dc03 by Ryan Scott at 2020-09-20T06:55:10-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - a963b809 by Ryan Scott at 2020-09-20T07:34:30-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - 30 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Misc.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 - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/ghc-bin.cabal.in - hadrian/cabal.project - hadrian/hadrian.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/845600f548f7096f2ec3a7a40f6287f71ea0bc75...a963b80945206584855af44d42c04f2db78d23ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/845600f548f7096f2ec3a7a40f6287f71ea0bc75...a963b80945206584855af44d42c04f2db78d23ea You're receiving 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 20 15:21:50 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Sun, 20 Sep 2020 11:21:50 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] fixup! Rewrite matchHasField to generate evidence more directly Message-ID: <5f67738e2bbd8_80b3f848776816c13306071@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: a943914b by Adam Gundry at 2020-09-20T16:20:58+01:00 fixup! Rewrite matchHasField to generate evidence more directly - - - - - 1 changed file: - compiler/GHC/Tc/Instance/Class.hs Changes: ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -691,7 +691,7 @@ matchHasField dflags short_cut clas tys -- the field selector should be in scope , Just gre <- lookupGRE_FieldLabel rdr_env fl - -> ASSERT ( k `eqType` typeSymbolKind ) + -> ASSERT( k `eqType` typeSymbolKind ) -- Look up the updater and instantiate its type with fresh metavars do { upd_id <- tcLookupId (flUpdate fl) ; inst_upd@(_, _, upd_ty) <- tcInstType newMetaTyVars upd_id View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a943914b0cc0c9a399bd575651a2ba4ab9375ae8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a943914b0cc0c9a399bd575651a2ba4ab9375ae8 You're receiving 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 20 15:50:34 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 20 Sep 2020 11:50:34 -0400 Subject: [Git][ghc/ghc][wip/T18599] improve error reporting Message-ID: <5f677a4a1cab7_80b3f84300b5e341330676e@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: f134aaa3 by Shayne Fletcher at 2020-09-20T11:50:20-04:00 improve error reporting - - - - - 12 changed files: - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Parser.Annotation +import Data.Either import Data.List import Data.Foldable import GHC.Driver.Session ( WarningFlag(..), DynFlags ) @@ -153,11 +154,14 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located (Located b -> Located b)) -fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) -fbindToRecField (Fbind f) = f -fbindToRecField _ = panic "fbindToRecField: The impossible happened" +fbindsToEithers :: [Fbind b] -> [Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b))] +fbindsToEithers = fmap fbindToEither + where + fbindToEither :: Fbind b -> Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b)) + fbindToEither (Fbind x) = Left x + fbindToEither (Pbind x) = Right x {- ********************************************************************** @@ -1393,7 +1397,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 :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located (Located b -> Located b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1525,7 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV l _ _ = - cmdFail l $ - text "Field selector syntax is not supported in commands." + mkHsFieldUpdaterPV l _ _ = cmdFail l (text "Use of RecordDotSyntax `.' not valid.") 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 @@ -1557,8 +1559,12 @@ instance DisambECP (HsCmd GhcPs) where mkHsExplicitListPV l xs = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) mkHsSplicePV (L l sp) = cmdFail l (ppr sp) - mkHsRecordPV _ l _ a (fbinds, ddLoc) = cmdFail l $ - ppr a <+> ppr (mk_rec_fields fbinds ddLoc) + mkHsRecordPV _ l _ a (fbinds, ddLoc) = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc) mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a) mkHsSectionR_PV l op c = cmdFail l $ let pp_op = fromMaybe (panic "cannot print infix operator") @@ -1587,7 +1593,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV l fields arg = return $ mkFieldUpdater l 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 @@ -1677,7 +1683,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field selector syntax is not supported in patterns." + text "Use of RecordDotSyntax `.' not valid." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." @@ -1709,8 +1715,13 @@ instance DisambECP (PatBuilder GhcPs) where return (L l (PatBuilderPat (ListPat noExtField ps))) mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV _ l _ a (fbinds, ddLoc) = do - r <- mkPatRec a (mk_rec_fields fbinds ddLoc) - checkRecordSyntax (L l r) + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text " Use of RecordDotSyntax `.' not valid.") + else do + r <- mkPatRec a (mk_rec_fields fs ddLoc) + checkRecordSyntax (L l r) mkHsNegAppPV l (L lp p) = do lit <- case p of PatBuilderOverLit pos_lit -> return (L lp pos_lit) @@ -2352,20 +2363,31 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) -mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fbinds,dd) | isRdrDataCon c - = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) + = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else 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 fs) + | otherwise = mkRdrRecordUpd' dot exp fs -mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs -mkRdrRecordUpd' dot exp fbinds = +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs) +mkRdrRecordUpd' dot exp@(L lexp _) fbinds = if not dot - then - mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) - else - foldl' fieldUpdate (unLoc exp) fbinds + then do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + -- If RecordDotSyntax is not enabled (as indicated by the + -- value of 'dot'), then the lexer will never an ITproj token + -- and so this case is refuted. + panic "mkRdrRecordUpd': The impossible happened!" + else return $ mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs) + else + return $ foldl' fieldUpdate (unLoc exp) fbinds where fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs fieldUpdate acc f = @@ -2374,7 +2396,7 @@ mkRdrRecordUpd' dot exp fbinds = Fbind field -> let updField = fmap mk_rec_upd_field field in unLoc $ foldl' mkSetField (noLoc acc) [updField] - Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + Pbind (L _ fieldUpdater) -> unLoc (fieldUpdater (noLoc acc)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds @@ -2386,12 +2408,9 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } - - -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 :: [LHsRecField GhcPs (Located b)] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) +mk_rec_fields flds Nothing = HsRecFields { rec_flds = flds, rec_dotdot = Nothing } +mk_rec_fields flds (Just s) = HsRecFields { rec_flds = flds, rec_dotdot = Just (L s (length flds)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) @@ -2983,8 +3002,9 @@ mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs mkSet a (L _ fIELD) b = set_field `mkAppType` mkSelector fIELD `mkApp` a `mkApp` b -- mkFieldUpdater calculates functions representing dot notation record updates. -mkFieldUpdater :: [Located FastString] -> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs) +mkFieldUpdater :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs -> Located (LHsExpr GhcPs -> LHsExpr GhcPs) mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} + l fIELDS -- [foo, bar, baz, quux] arg -- This is 'texp' (43 in the example). = let { @@ -2995,7 +3015,7 @@ mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] } - in \a -> foldl' mkSet' arg (zips a) + in L l $ \a -> foldl' mkSet' arg (zips a) -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux)))) where mkSet' :: LHsExpr GhcPs -> (Located FastString, LHsExpr GhcPs) -> LHsExpr GhcPs ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -1,5 +1,2 @@ -ghc: panic! (the 'impossible' happened) - (GHC version 8.11.0.20200909: - fbindToRecField: The impossible happened - -Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + RecordDotSyntaxFail0.hs:3:12: + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE RecordDotSyntax #-} no Foo { bar.baz = x } = undefined - -- Syntax error: "Field selector syntax is not supported in - -- patterns." + -- Syntax error: Field selector syntax doesn't participate + -- in patterns ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -1,2 +1,2 @@ RecordDotSyntaxFail1.hs:3:10: - Field selector syntax is not supported in patterns. + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoRecordDotSyntax #-} + +data Foo = Foo { foo :: Bar } +data Bar = Bar { bar :: Baz } +data Baz = Baz { baz :: Quux } +data Quux = Quux { quux :: Int } + +no :: Foo -> Foo +no = Foo { bar.baz = Quux {quux = 42}}} } + -- Syntax error: RecordDotSyntax is not enabled ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail2.hs:9:15: parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordDotSyntax #-} + +class HasField x r a | x r -> a where + hasField :: r -> (a -> r, a) + +getField :: forall x r a . HasField x r a => r -> a +getField = snd . hasField @x -- Note: a.x = is getField @"x" a. + +setField :: forall x r a . HasField x r a => r -> a -> r +setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. + +-- 'Corge' has a '&&&' field of type 'Int' +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) +instance HasField "&&&" Corge Int where + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) + +main = do + let b = Corge{ (&&&) = 12 }; + print $ (b.(&&&)) + -- Syntax error: Dot notation is not available for fields with + -- operator names ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordDotSyntax #-} + +data Foo = Foo { foo :: Int } + +main = do + let a = Foo { foo = 1 } + print $ (const "hello") a .foo + -- Syntax error: f r .x is illegal. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail4.hs:7:29: error: + parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -175,3 +175,6 @@ test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) test('RecordDotSyntaxFail0', normal, compile_fail, ['']) test('RecordDotSyntaxFail1', normal, compile_fail, ['']) +test('RecordDotSyntaxFail2', normal, compile_fail, ['']) +test('RecordDotSyntaxFail3', normal, compile_fail, ['']) +test('RecordDotSyntaxFail4', normal, compile_fail, ['']) ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -17,52 +17,52 @@ setField :: forall x r a . HasField x r a => r -> a -> r setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. -- 'Foo' has 'foo' field of type 'Bar' -data Foo = Foo {foo :: Bar} deriving (Show, Eq) +data Foo = Foo { foo :: Bar } deriving (Show, Eq) instance HasField "foo" Foo Bar where - hasField r = (\x -> case r of Foo{..} -> Foo {foo = x, ..}, foo r) + hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r) -- 'Bar' has a 'bar' field of type 'Baz' -data Bar = Bar {bar :: Baz} deriving (Show, Eq) +data Bar = Bar { bar :: Baz } deriving (Show, Eq) instance HasField "bar" Bar Baz where - hasField r = (\x -> case r of Bar{..} -> Bar {bar = x, ..}, bar r) + hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r) -- 'Baz' has a 'baz' field of type 'Quux' -data Baz = Baz {baz :: Quux} deriving (Show, Eq) +data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where - hasField r = (\x -> case r of Baz{..} -> Baz {baz = x, ..}, baz r) + hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) -- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux {quux :: Int} deriving (Show, Eq) +data Quux = Quux { quux :: Int } deriving (Show, Eq) instance HasField "quux" Quux Int where - hasField r = (\x -> case r of Quux{..} -> Quux {quux = x, ..}, quux r) + hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r) -- 'Corge' has a '&&&' field of type 'Int' -data Corge = Corge {(&&&) :: Int} deriving (Show, Eq) +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) instance HasField "&&&" Corge Int where - hasField r = (\x -> case r of Corge{..} -> Corge {(&&&) = x, ..}, (&&&) r) + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) -- Note : Dot notation is not available for fields with operator -- names. -- 'Grault' has two fields 'f' and 'g' of type 'Foo'. data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq) instance HasField "f" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {f = x, ..}, f r) + hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r) instance HasField "g" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {g = x, ..}, g r) + hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r) main = do - let a = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 42}}}} - let b = Corge{(&&&) = 12}; + let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } + let b = Corge{ (&&&) = 12 }; let c = Grault { - f = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - , g = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - } + f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + } -- A "selector" is an expression like '(.a)' or '(.a.b)'. putStrLn "-- selectors:" - print $ (.foo) a -- Bar {bar = Baz {baz = Quux {quux = 42}}} - print $ (.foo.bar) a -- Baz {baz = Quux {quux = 42}} - print $ (.foo.bar.baz) a -- Quux {quux = 42} + print $ (.foo) a -- Bar { bar = Baz { baz = Quux { quux = 42 } } } + print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } } + print $ (.foo.bar.baz) a -- Quux { quux = 42 } print $ (.foo.bar.baz.quux) a -- 42 print $ ((&&&) b) -- 12 -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’ @@ -71,9 +71,9 @@ main = do -- A "selection" is an expression like 'r.a' or '(f r).a.b'. putStrLn "-- selections:" print $ a.foo.bar.baz.quux -- 42 - print $ a.foo.bar.baz -- Quux {quux = 42} - print $ a.foo.bar -- Baz {baz = Quux {quux = 42}} - print $ a.foo -- Bar {bar = Baz {baz = Quux {quux = 42}}} + print $ a.foo.bar.baz -- Quux { quux = 42 } + print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } } + print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } } print $ (const "hello") a.foo -- f r.x means f (r.x) -- print $ f a .foo -- f r .x is illegal print $ (const "hello") (id a).foo -- f (g r).x means f ((g r).x) @@ -86,30 +86,30 @@ main = do print $ (+) (id a).foo.bar.baz.quux 1 -- 43 print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43 - -- An "update" is an expression like 'r{a.b = 12}'. + -- An "update" is an expression like 'r{ a.b = 12 }'. putStrLn "-- updates:" - print $ (a.foo.bar.baz) {quux = 2} -- Quux {quux = 2} - print $ (\b -> b{bar=Baz{baz=Quux{quux=1}}}) a.foo -- Bar {bar = Baz {baz = Quux {quux = 1}}} - let bar = Bar {bar = Baz {baz = Quux {quux = 44}}} - print $ a{foo.bar = Baz {baz = Quux {quux = 44}}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} - print $ a{foo.bar.baz = Quux {quux = 45}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} - print $ a{foo.bar.baz.quux = 46} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} - print $ c{f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4} -- Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} - - -- A "punned update" is an expression like 'r{a.b}' (where it is + print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 } + print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } } + let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } } + print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } } + print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } } + print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } } + print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } } + + -- A "punned update" is an expression like 'r{ a.b }' (where it is -- understood that 'b' is a variable binding in the environment of -- the field update - enabled only when the extension -- 'NamedFieldPuns' is in effect). putStrLn "-- punned updates:" - let quux = 102; baz = Quux {quux}; bar = Baz {baz}; foo = Bar {bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz.quux} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} - print $ c{f.foo, g.foo.bar.baz.quux = 4} -- Mix punned and explicit; 102, 4 + let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } } + print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4 f <- pure a g <- pure a - print $ c{f} -- 42, 1 - print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 + print $ c{ f } -- 42, 1 + print $ c{ f, g } -- 42, 42 + print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f134aaa3b4b856d8ee2df61a2262c2c7b4e0d3cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f134aaa3b4b856d8ee2df61a2262c2c7b4e0d3cd You're receiving 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 20 15:51:34 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 20 Sep 2020 11:51:34 -0400 Subject: [Git][ghc/ghc][wip/T18599] improve error reporting Message-ID: <5f677a866c6d3_80b111e5224133069f4@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: edef6d8c by Shayne Fletcher at 2020-09-20T11:51:07-04:00 improve error reporting - - - - - 12 changed files: - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Parser.Annotation +import Data.Either import Data.List import Data.Foldable import GHC.Driver.Session ( WarningFlag(..), DynFlags ) @@ -153,11 +154,14 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located (Located b -> Located b)) -fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) -fbindToRecField (Fbind f) = f -fbindToRecField _ = panic "fbindToRecField: The impossible happened" +fbindsToEithers :: [Fbind b] -> [Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b))] +fbindsToEithers = fmap fbindToEither + where + fbindToEither :: Fbind b -> Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b)) + fbindToEither (Fbind x) = Left x + fbindToEither (Pbind x) = Right x {- ********************************************************************** @@ -1393,7 +1397,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 :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located (Located b -> Located b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1525,7 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV l _ _ = - cmdFail l $ - text "Field selector syntax is not supported in commands." + mkHsFieldUpdaterPV l _ _ = cmdFail l (text "Use of RecordDotSyntax `.' not valid.") 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 @@ -1557,8 +1559,12 @@ instance DisambECP (HsCmd GhcPs) where mkHsExplicitListPV l xs = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) mkHsSplicePV (L l sp) = cmdFail l (ppr sp) - mkHsRecordPV _ l _ a (fbinds, ddLoc) = cmdFail l $ - ppr a <+> ppr (mk_rec_fields fbinds ddLoc) + mkHsRecordPV _ l _ a (fbinds, ddLoc) = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc) mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a) mkHsSectionR_PV l op c = cmdFail l $ let pp_op = fromMaybe (panic "cannot print infix operator") @@ -1587,7 +1593,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV l fields arg = return $ mkFieldUpdater l 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 @@ -1677,7 +1683,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field selector syntax is not supported in patterns." + text "Use of RecordDotSyntax `.' not valid." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." @@ -1709,8 +1715,13 @@ instance DisambECP (PatBuilder GhcPs) where return (L l (PatBuilderPat (ListPat noExtField ps))) mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV _ l _ a (fbinds, ddLoc) = do - r <- mkPatRec a (mk_rec_fields fbinds ddLoc) - checkRecordSyntax (L l r) + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text " Use of RecordDotSyntax `.' not valid.") + else do + r <- mkPatRec a (mk_rec_fields fs ddLoc) + checkRecordSyntax (L l r) mkHsNegAppPV l (L lp p) = do lit <- case p of PatBuilderOverLit pos_lit -> return (L lp pos_lit) @@ -2352,20 +2363,31 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) -mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fbinds,dd) | isRdrDataCon c - = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) + = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else 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 fs) + | otherwise = mkRdrRecordUpd' dot exp fs -mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs -mkRdrRecordUpd' dot exp fbinds = +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs) +mkRdrRecordUpd' dot exp@(L lexp _) fbinds = if not dot - then - mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) - else - foldl' fieldUpdate (unLoc exp) fbinds + then do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + -- If RecordDotSyntax is not enabled (as indicated by the + -- value of 'dot'), then the lexer will never an ITproj token + -- and so this case is refuted. + panic "mkRdrRecordUpd': The impossible happened!" + else return $ mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs) + else + return $ foldl' fieldUpdate (unLoc exp) fbinds where fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs fieldUpdate acc f = @@ -2374,7 +2396,7 @@ mkRdrRecordUpd' dot exp fbinds = Fbind field -> let updField = fmap mk_rec_upd_field field in unLoc $ foldl' mkSetField (noLoc acc) [updField] - Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + Pbind (L _ fieldUpdater) -> unLoc (fieldUpdater (noLoc acc)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds @@ -2386,12 +2408,9 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } - - -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 :: [LHsRecField GhcPs (Located b)] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) +mk_rec_fields flds Nothing = HsRecFields { rec_flds = flds, rec_dotdot = Nothing } +mk_rec_fields flds (Just s) = HsRecFields { rec_flds = flds, rec_dotdot = Just (L s (length flds)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) @@ -2983,8 +3002,9 @@ mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs mkSet a (L _ fIELD) b = set_field `mkAppType` mkSelector fIELD `mkApp` a `mkApp` b -- mkFieldUpdater calculates functions representing dot notation record updates. -mkFieldUpdater :: [Located FastString] -> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs) +mkFieldUpdater :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs -> Located (LHsExpr GhcPs -> LHsExpr GhcPs) mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} + l fIELDS -- [foo, bar, baz, quux] arg -- This is 'texp' (43 in the example). = let { @@ -2995,7 +3015,7 @@ mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] } - in \a -> foldl' mkSet' arg (zips a) + in L l $ \a -> foldl' mkSet' arg (zips a) -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux)))) where mkSet' :: LHsExpr GhcPs -> (Located FastString, LHsExpr GhcPs) -> LHsExpr GhcPs ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -1,5 +1,2 @@ -ghc: panic! (the 'impossible' happened) - (GHC version 8.11.0.20200909: - fbindToRecField: The impossible happened - -Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + RecordDotSyntaxFail0.hs:3:12: + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE RecordDotSyntax #-} no Foo { bar.baz = x } = undefined - -- Syntax error: "Field selector syntax is not supported in - -- patterns." + -- Syntax error: Field selector syntax doesn't participate + -- in patterns ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -1,2 +1,2 @@ RecordDotSyntaxFail1.hs:3:10: - Field selector syntax is not supported in patterns. + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoRecordDotSyntax #-} + +data Foo = Foo { foo :: Bar } +data Bar = Bar { bar :: Baz } +data Baz = Baz { baz :: Quux } +data Quux = Quux { quux :: Int } + +no :: Foo -> Foo +no = Foo { bar.baz = Quux {quux = 42}}} } + -- Syntax error: RecordDotSyntax is not enabled ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail2.hs:9:15: parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordDotSyntax #-} + +class HasField x r a | x r -> a where + hasField :: r -> (a -> r, a) + +getField :: forall x r a . HasField x r a => r -> a +getField = snd . hasField @x -- Note: a.x = is getField @"x" a. + +setField :: forall x r a . HasField x r a => r -> a -> r +setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. + +-- 'Corge' has a '&&&' field of type 'Int' +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) +instance HasField "&&&" Corge Int where + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) + +main = do + let b = Corge { (&&&) = 12 }; + print $ (b.(&&&)) + -- Syntax error: Dot notation is not available for fields with + -- operator names ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordDotSyntax #-} + +data Foo = Foo { foo :: Int } + +main = do + let a = Foo { foo = 1 } + print $ (const "hello") a .foo + -- Syntax error: f r .x is illegal. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail4.hs:7:29: error: + parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -175,3 +175,6 @@ test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) test('RecordDotSyntaxFail0', normal, compile_fail, ['']) test('RecordDotSyntaxFail1', normal, compile_fail, ['']) +test('RecordDotSyntaxFail2', normal, compile_fail, ['']) +test('RecordDotSyntaxFail3', normal, compile_fail, ['']) +test('RecordDotSyntaxFail4', normal, compile_fail, ['']) ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -17,52 +17,52 @@ setField :: forall x r a . HasField x r a => r -> a -> r setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. -- 'Foo' has 'foo' field of type 'Bar' -data Foo = Foo {foo :: Bar} deriving (Show, Eq) +data Foo = Foo { foo :: Bar } deriving (Show, Eq) instance HasField "foo" Foo Bar where - hasField r = (\x -> case r of Foo{..} -> Foo {foo = x, ..}, foo r) + hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r) -- 'Bar' has a 'bar' field of type 'Baz' -data Bar = Bar {bar :: Baz} deriving (Show, Eq) +data Bar = Bar { bar :: Baz } deriving (Show, Eq) instance HasField "bar" Bar Baz where - hasField r = (\x -> case r of Bar{..} -> Bar {bar = x, ..}, bar r) + hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r) -- 'Baz' has a 'baz' field of type 'Quux' -data Baz = Baz {baz :: Quux} deriving (Show, Eq) +data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where - hasField r = (\x -> case r of Baz{..} -> Baz {baz = x, ..}, baz r) + hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) -- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux {quux :: Int} deriving (Show, Eq) +data Quux = Quux { quux :: Int } deriving (Show, Eq) instance HasField "quux" Quux Int where - hasField r = (\x -> case r of Quux{..} -> Quux {quux = x, ..}, quux r) + hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r) -- 'Corge' has a '&&&' field of type 'Int' -data Corge = Corge {(&&&) :: Int} deriving (Show, Eq) +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) instance HasField "&&&" Corge Int where - hasField r = (\x -> case r of Corge{..} -> Corge {(&&&) = x, ..}, (&&&) r) + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) -- Note : Dot notation is not available for fields with operator -- names. -- 'Grault' has two fields 'f' and 'g' of type 'Foo'. data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq) instance HasField "f" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {f = x, ..}, f r) + hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r) instance HasField "g" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {g = x, ..}, g r) + hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r) main = do - let a = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 42}}}} - let b = Corge{(&&&) = 12}; + let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } + let b = Corge{ (&&&) = 12 }; let c = Grault { - f = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - , g = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - } + f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + } -- A "selector" is an expression like '(.a)' or '(.a.b)'. putStrLn "-- selectors:" - print $ (.foo) a -- Bar {bar = Baz {baz = Quux {quux = 42}}} - print $ (.foo.bar) a -- Baz {baz = Quux {quux = 42}} - print $ (.foo.bar.baz) a -- Quux {quux = 42} + print $ (.foo) a -- Bar { bar = Baz { baz = Quux { quux = 42 } } } + print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } } + print $ (.foo.bar.baz) a -- Quux { quux = 42 } print $ (.foo.bar.baz.quux) a -- 42 print $ ((&&&) b) -- 12 -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’ @@ -71,9 +71,9 @@ main = do -- A "selection" is an expression like 'r.a' or '(f r).a.b'. putStrLn "-- selections:" print $ a.foo.bar.baz.quux -- 42 - print $ a.foo.bar.baz -- Quux {quux = 42} - print $ a.foo.bar -- Baz {baz = Quux {quux = 42}} - print $ a.foo -- Bar {bar = Baz {baz = Quux {quux = 42}}} + print $ a.foo.bar.baz -- Quux { quux = 42 } + print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } } + print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } } print $ (const "hello") a.foo -- f r.x means f (r.x) -- print $ f a .foo -- f r .x is illegal print $ (const "hello") (id a).foo -- f (g r).x means f ((g r).x) @@ -86,30 +86,30 @@ main = do print $ (+) (id a).foo.bar.baz.quux 1 -- 43 print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43 - -- An "update" is an expression like 'r{a.b = 12}'. + -- An "update" is an expression like 'r{ a.b = 12 }'. putStrLn "-- updates:" - print $ (a.foo.bar.baz) {quux = 2} -- Quux {quux = 2} - print $ (\b -> b{bar=Baz{baz=Quux{quux=1}}}) a.foo -- Bar {bar = Baz {baz = Quux {quux = 1}}} - let bar = Bar {bar = Baz {baz = Quux {quux = 44}}} - print $ a{foo.bar = Baz {baz = Quux {quux = 44}}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} - print $ a{foo.bar.baz = Quux {quux = 45}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} - print $ a{foo.bar.baz.quux = 46} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} - print $ c{f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4} -- Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} - - -- A "punned update" is an expression like 'r{a.b}' (where it is + print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 } + print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } } + let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } } + print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } } + print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } } + print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } } + print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } } + + -- A "punned update" is an expression like 'r{ a.b }' (where it is -- understood that 'b' is a variable binding in the environment of -- the field update - enabled only when the extension -- 'NamedFieldPuns' is in effect). putStrLn "-- punned updates:" - let quux = 102; baz = Quux {quux}; bar = Baz {baz}; foo = Bar {bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz.quux} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} - print $ c{f.foo, g.foo.bar.baz.quux = 4} -- Mix punned and explicit; 102, 4 + let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } } + print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4 f <- pure a g <- pure a - print $ c{f} -- 42, 1 - print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 + print $ c{ f } -- 42, 1 + print $ c{ f, g } -- 42, 42 + print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edef6d8c47ce8bf35335f5b82f50044c6ba85934 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edef6d8c47ce8bf35335f5b82f50044c6ba85934 You're receiving 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 20 15:52:41 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 20 Sep 2020 11:52:41 -0400 Subject: [Git][ghc/ghc][wip/T18599] improve error reporting Message-ID: <5f677ac95a89c_80b3f84870600b813307146@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: a1e418ad by Shayne Fletcher at 2020-09-20T11:52:25-04:00 improve error reporting - - - - - 12 changed files: - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Parser.Annotation +import Data.Either import Data.List import Data.Foldable import GHC.Driver.Session ( WarningFlag(..), DynFlags ) @@ -153,11 +154,14 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located (Located b -> Located b)) -fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) -fbindToRecField (Fbind f) = f -fbindToRecField _ = panic "fbindToRecField: The impossible happened" +fbindsToEithers :: [Fbind b] -> [Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b))] +fbindsToEithers = fmap fbindToEither + where + fbindToEither :: Fbind b -> Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b)) + fbindToEither (Fbind x) = Left x + fbindToEither (Pbind x) = Right x {- ********************************************************************** @@ -1393,7 +1397,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 :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located (Located b -> Located b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1525,7 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV l _ _ = - cmdFail l $ - text "Field selector syntax is not supported in commands." + mkHsFieldUpdaterPV l _ _ = cmdFail l (text "Use of RecordDotSyntax `.' not valid.") 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 @@ -1557,8 +1559,12 @@ instance DisambECP (HsCmd GhcPs) where mkHsExplicitListPV l xs = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) mkHsSplicePV (L l sp) = cmdFail l (ppr sp) - mkHsRecordPV _ l _ a (fbinds, ddLoc) = cmdFail l $ - ppr a <+> ppr (mk_rec_fields fbinds ddLoc) + mkHsRecordPV _ l _ a (fbinds, ddLoc) = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc) mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a) mkHsSectionR_PV l op c = cmdFail l $ let pp_op = fromMaybe (panic "cannot print infix operator") @@ -1587,7 +1593,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV l fields arg = return $ mkFieldUpdater l 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 @@ -1677,7 +1683,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field selector syntax is not supported in patterns." + text "Use of RecordDotSyntax `.' not valid." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." @@ -1709,8 +1715,13 @@ instance DisambECP (PatBuilder GhcPs) where return (L l (PatBuilderPat (ListPat noExtField ps))) mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV _ l _ a (fbinds, ddLoc) = do - r <- mkPatRec a (mk_rec_fields fbinds ddLoc) - checkRecordSyntax (L l r) + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text " Use of RecordDotSyntax `.' not valid.") + else do + r <- mkPatRec a (mk_rec_fields fs ddLoc) + checkRecordSyntax (L l r) mkHsNegAppPV l (L lp p) = do lit <- case p of PatBuilderOverLit pos_lit -> return (L lp pos_lit) @@ -2352,20 +2363,31 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) -mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fbinds,dd) | isRdrDataCon c - = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) + = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else 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 fs) + | otherwise = mkRdrRecordUpd' dot exp fs -mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs -mkRdrRecordUpd' dot exp fbinds = +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs) +mkRdrRecordUpd' dot exp@(L lexp _) fbinds = if not dot - then - mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) - else - foldl' fieldUpdate (unLoc exp) fbinds + then do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + -- If RecordDotSyntax is not enabled (as indicated by the + -- value of 'dot'), then the lexer will never an ITproj token + -- and so this case is refuted. + panic "mkRdrRecordUpd': The impossible happened!" + else return $ mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs) + else + return $ foldl' fieldUpdate (unLoc exp) fbinds where fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs fieldUpdate acc f = @@ -2374,7 +2396,7 @@ mkRdrRecordUpd' dot exp fbinds = Fbind field -> let updField = fmap mk_rec_upd_field field in unLoc $ foldl' mkSetField (noLoc acc) [updField] - Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + Pbind (L _ fieldUpdater) -> unLoc (fieldUpdater (noLoc acc)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds @@ -2386,12 +2408,9 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } - - -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 :: [LHsRecField GhcPs (Located b)] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) +mk_rec_fields flds Nothing = HsRecFields { rec_flds = flds, rec_dotdot = Nothing } +mk_rec_fields flds (Just s) = HsRecFields { rec_flds = flds, rec_dotdot = Just (L s (length flds)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) @@ -2983,8 +3002,9 @@ mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs mkSet a (L _ fIELD) b = set_field `mkAppType` mkSelector fIELD `mkApp` a `mkApp` b -- mkFieldUpdater calculates functions representing dot notation record updates. -mkFieldUpdater :: [Located FastString] -> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs) +mkFieldUpdater :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs -> Located (LHsExpr GhcPs -> LHsExpr GhcPs) mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} + l fIELDS -- [foo, bar, baz, quux] arg -- This is 'texp' (43 in the example). = let { @@ -2995,7 +3015,7 @@ mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] } - in \a -> foldl' mkSet' arg (zips a) + in L l $ \a -> foldl' mkSet' arg (zips a) -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux)))) where mkSet' :: LHsExpr GhcPs -> (Located FastString, LHsExpr GhcPs) -> LHsExpr GhcPs ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -1,5 +1,2 @@ -ghc: panic! (the 'impossible' happened) - (GHC version 8.11.0.20200909: - fbindToRecField: The impossible happened - -Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + RecordDotSyntaxFail0.hs:3:12: + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE RecordDotSyntax #-} no Foo { bar.baz = x } = undefined - -- Syntax error: "Field selector syntax is not supported in - -- patterns." + -- Syntax error: Field selector syntax doesn't participate + -- in patterns ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -1,2 +1,2 @@ RecordDotSyntaxFail1.hs:3:10: - Field selector syntax is not supported in patterns. + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoRecordDotSyntax #-} + +data Foo = Foo { foo :: Bar } +data Bar = Bar { bar :: Baz } +data Baz = Baz { baz :: Quux } +data Quux = Quux { quux :: Int } + +no :: Foo -> Foo +no = Foo { bar.baz = Quux { quux = 42 } } } } + -- Syntax error: RecordDotSyntax is not enabled ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail2.hs:9:15: parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordDotSyntax #-} + +class HasField x r a | x r -> a where + hasField :: r -> (a -> r, a) + +getField :: forall x r a . HasField x r a => r -> a +getField = snd . hasField @x -- Note: a.x = is getField @"x" a. + +setField :: forall x r a . HasField x r a => r -> a -> r +setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. + +-- 'Corge' has a '&&&' field of type 'Int' +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) +instance HasField "&&&" Corge Int where + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) + +main = do + let b = Corge { (&&&) = 12 }; + print $ (b.(&&&)) + -- Syntax error: Dot notation is not available for fields with + -- operator names ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordDotSyntax #-} + +data Foo = Foo { foo :: Int } + +main = do + let a = Foo { foo = 1 } + print $ (const "hello") a .foo + -- Syntax error: f r .x is illegal. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail4.hs:7:29: error: + parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -175,3 +175,6 @@ test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) test('RecordDotSyntaxFail0', normal, compile_fail, ['']) test('RecordDotSyntaxFail1', normal, compile_fail, ['']) +test('RecordDotSyntaxFail2', normal, compile_fail, ['']) +test('RecordDotSyntaxFail3', normal, compile_fail, ['']) +test('RecordDotSyntaxFail4', normal, compile_fail, ['']) ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -17,52 +17,52 @@ setField :: forall x r a . HasField x r a => r -> a -> r setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. -- 'Foo' has 'foo' field of type 'Bar' -data Foo = Foo {foo :: Bar} deriving (Show, Eq) +data Foo = Foo { foo :: Bar } deriving (Show, Eq) instance HasField "foo" Foo Bar where - hasField r = (\x -> case r of Foo{..} -> Foo {foo = x, ..}, foo r) + hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r) -- 'Bar' has a 'bar' field of type 'Baz' -data Bar = Bar {bar :: Baz} deriving (Show, Eq) +data Bar = Bar { bar :: Baz } deriving (Show, Eq) instance HasField "bar" Bar Baz where - hasField r = (\x -> case r of Bar{..} -> Bar {bar = x, ..}, bar r) + hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r) -- 'Baz' has a 'baz' field of type 'Quux' -data Baz = Baz {baz :: Quux} deriving (Show, Eq) +data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where - hasField r = (\x -> case r of Baz{..} -> Baz {baz = x, ..}, baz r) + hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) -- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux {quux :: Int} deriving (Show, Eq) +data Quux = Quux { quux :: Int } deriving (Show, Eq) instance HasField "quux" Quux Int where - hasField r = (\x -> case r of Quux{..} -> Quux {quux = x, ..}, quux r) + hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r) -- 'Corge' has a '&&&' field of type 'Int' -data Corge = Corge {(&&&) :: Int} deriving (Show, Eq) +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) instance HasField "&&&" Corge Int where - hasField r = (\x -> case r of Corge{..} -> Corge {(&&&) = x, ..}, (&&&) r) + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) -- Note : Dot notation is not available for fields with operator -- names. -- 'Grault' has two fields 'f' and 'g' of type 'Foo'. data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq) instance HasField "f" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {f = x, ..}, f r) + hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r) instance HasField "g" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {g = x, ..}, g r) + hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r) main = do - let a = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 42}}}} - let b = Corge{(&&&) = 12}; + let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } + let b = Corge{ (&&&) = 12 }; let c = Grault { - f = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - , g = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - } + f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + } -- A "selector" is an expression like '(.a)' or '(.a.b)'. putStrLn "-- selectors:" - print $ (.foo) a -- Bar {bar = Baz {baz = Quux {quux = 42}}} - print $ (.foo.bar) a -- Baz {baz = Quux {quux = 42}} - print $ (.foo.bar.baz) a -- Quux {quux = 42} + print $ (.foo) a -- Bar { bar = Baz { baz = Quux { quux = 42 } } } + print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } } + print $ (.foo.bar.baz) a -- Quux { quux = 42 } print $ (.foo.bar.baz.quux) a -- 42 print $ ((&&&) b) -- 12 -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’ @@ -71,9 +71,9 @@ main = do -- A "selection" is an expression like 'r.a' or '(f r).a.b'. putStrLn "-- selections:" print $ a.foo.bar.baz.quux -- 42 - print $ a.foo.bar.baz -- Quux {quux = 42} - print $ a.foo.bar -- Baz {baz = Quux {quux = 42}} - print $ a.foo -- Bar {bar = Baz {baz = Quux {quux = 42}}} + print $ a.foo.bar.baz -- Quux { quux = 42 } + print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } } + print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } } print $ (const "hello") a.foo -- f r.x means f (r.x) -- print $ f a .foo -- f r .x is illegal print $ (const "hello") (id a).foo -- f (g r).x means f ((g r).x) @@ -86,30 +86,30 @@ main = do print $ (+) (id a).foo.bar.baz.quux 1 -- 43 print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43 - -- An "update" is an expression like 'r{a.b = 12}'. + -- An "update" is an expression like 'r{ a.b = 12 }'. putStrLn "-- updates:" - print $ (a.foo.bar.baz) {quux = 2} -- Quux {quux = 2} - print $ (\b -> b{bar=Baz{baz=Quux{quux=1}}}) a.foo -- Bar {bar = Baz {baz = Quux {quux = 1}}} - let bar = Bar {bar = Baz {baz = Quux {quux = 44}}} - print $ a{foo.bar = Baz {baz = Quux {quux = 44}}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} - print $ a{foo.bar.baz = Quux {quux = 45}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} - print $ a{foo.bar.baz.quux = 46} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} - print $ c{f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4} -- Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} - - -- A "punned update" is an expression like 'r{a.b}' (where it is + print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 } + print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } } + let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } } + print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } } + print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } } + print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } } + print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } } + + -- A "punned update" is an expression like 'r{ a.b }' (where it is -- understood that 'b' is a variable binding in the environment of -- the field update - enabled only when the extension -- 'NamedFieldPuns' is in effect). putStrLn "-- punned updates:" - let quux = 102; baz = Quux {quux}; bar = Baz {baz}; foo = Bar {bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz.quux} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} - print $ c{f.foo, g.foo.bar.baz.quux = 4} -- Mix punned and explicit; 102, 4 + let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } } + print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4 f <- pure a g <- pure a - print $ c{f} -- 42, 1 - print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 + print $ c{ f } -- 42, 1 + print $ c{ f, g } -- 42, 42 + print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1e418ad614bf4c7b22814d2f2a24328e7da55ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1e418ad614bf4c7b22814d2f2a24328e7da55ef You're receiving 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 20 15:54:31 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 20 Sep 2020 11:54:31 -0400 Subject: [Git][ghc/ghc][wip/T18599] improve error reporting Message-ID: <5f677b37a5ae4_80b3f84961ef604133087e8@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: f035d397 by Shayne Fletcher at 2020-09-20T11:54:15-04:00 improve error reporting - - - - - 12 changed files: - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Parser.Annotation +import Data.Either import Data.List import Data.Foldable import GHC.Driver.Session ( WarningFlag(..), DynFlags ) @@ -153,11 +154,14 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located (Located b -> Located b)) -fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) -fbindToRecField (Fbind f) = f -fbindToRecField _ = panic "fbindToRecField: The impossible happened" +fbindsToEithers :: [Fbind b] -> [Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b))] +fbindsToEithers = fmap fbindToEither + where + fbindToEither :: Fbind b -> Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b)) + fbindToEither (Fbind x) = Left x + fbindToEither (Pbind x) = Right x {- ********************************************************************** @@ -1393,7 +1397,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 :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located (Located b -> Located b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1525,7 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV l _ _ = - cmdFail l $ - text "Field selector syntax is not supported in commands." + mkHsFieldUpdaterPV l _ _ = cmdFail l (text "Use of RecordDotSyntax `.' not valid.") 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 @@ -1557,8 +1559,12 @@ instance DisambECP (HsCmd GhcPs) where mkHsExplicitListPV l xs = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) mkHsSplicePV (L l sp) = cmdFail l (ppr sp) - mkHsRecordPV _ l _ a (fbinds, ddLoc) = cmdFail l $ - ppr a <+> ppr (mk_rec_fields fbinds ddLoc) + mkHsRecordPV _ l _ a (fbinds, ddLoc) = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc) mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a) mkHsSectionR_PV l op c = cmdFail l $ let pp_op = fromMaybe (panic "cannot print infix operator") @@ -1587,7 +1593,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV l fields arg = return $ mkFieldUpdater l 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 @@ -1677,7 +1683,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field selector syntax is not supported in patterns." + text "Use of RecordDotSyntax `.' not valid." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." @@ -1709,8 +1715,13 @@ instance DisambECP (PatBuilder GhcPs) where return (L l (PatBuilderPat (ListPat noExtField ps))) mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV _ l _ a (fbinds, ddLoc) = do - r <- mkPatRec a (mk_rec_fields fbinds ddLoc) - checkRecordSyntax (L l r) + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text " Use of RecordDotSyntax `.' not valid.") + else do + r <- mkPatRec a (mk_rec_fields fs ddLoc) + checkRecordSyntax (L l r) mkHsNegAppPV l (L lp p) = do lit <- case p of PatBuilderOverLit pos_lit -> return (L lp pos_lit) @@ -2352,20 +2363,31 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) -mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fbinds,dd) | isRdrDataCon c - = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) + = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else 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 fs) + | otherwise = mkRdrRecordUpd' dot exp fs -mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs -mkRdrRecordUpd' dot exp fbinds = +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs) +mkRdrRecordUpd' dot exp@(L lexp _) fbinds = if not dot - then - mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) - else - foldl' fieldUpdate (unLoc exp) fbinds + then do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + -- If RecordDotSyntax is not enabled (as indicated by the + -- value of 'dot'), then the lexer can't ever issue an ITproj + -- token and so this case is refuted. + panic "mkRdrRecordUpd': The impossible happened!" + else return $ mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs) + else + return $ foldl' fieldUpdate (unLoc exp) fbinds where fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs fieldUpdate acc f = @@ -2374,7 +2396,7 @@ mkRdrRecordUpd' dot exp fbinds = Fbind field -> let updField = fmap mk_rec_upd_field field in unLoc $ foldl' mkSetField (noLoc acc) [updField] - Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + Pbind (L _ fieldUpdater) -> unLoc (fieldUpdater (noLoc acc)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds @@ -2386,12 +2408,9 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } - - -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 :: [LHsRecField GhcPs (Located b)] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) +mk_rec_fields flds Nothing = HsRecFields { rec_flds = flds, rec_dotdot = Nothing } +mk_rec_fields flds (Just s) = HsRecFields { rec_flds = flds, rec_dotdot = Just (L s (length flds)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) @@ -2983,8 +3002,9 @@ mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs mkSet a (L _ fIELD) b = set_field `mkAppType` mkSelector fIELD `mkApp` a `mkApp` b -- mkFieldUpdater calculates functions representing dot notation record updates. -mkFieldUpdater :: [Located FastString] -> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs) +mkFieldUpdater :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs -> Located (LHsExpr GhcPs -> LHsExpr GhcPs) mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} + l fIELDS -- [foo, bar, baz, quux] arg -- This is 'texp' (43 in the example). = let { @@ -2995,7 +3015,7 @@ mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] } - in \a -> foldl' mkSet' arg (zips a) + in L l $ \a -> foldl' mkSet' arg (zips a) -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux)))) where mkSet' :: LHsExpr GhcPs -> (Located FastString, LHsExpr GhcPs) -> LHsExpr GhcPs ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -1,5 +1,2 @@ -ghc: panic! (the 'impossible' happened) - (GHC version 8.11.0.20200909: - fbindToRecField: The impossible happened - -Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + RecordDotSyntaxFail0.hs:3:12: + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE RecordDotSyntax #-} no Foo { bar.baz = x } = undefined - -- Syntax error: "Field selector syntax is not supported in - -- patterns." + -- Syntax error: Field selector syntax doesn't participate + -- in patterns ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -1,2 +1,2 @@ RecordDotSyntaxFail1.hs:3:10: - Field selector syntax is not supported in patterns. + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoRecordDotSyntax #-} + +data Foo = Foo { foo :: Bar } +data Bar = Bar { bar :: Baz } +data Baz = Baz { baz :: Quux } +data Quux = Quux { quux :: Int } + +no :: Foo -> Foo +no = Foo { bar.baz = Quux { quux = 42 } } } } + -- Syntax error: RecordDotSyntax is not enabled ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail2.hs:9:15: parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordDotSyntax #-} + +class HasField x r a | x r -> a where + hasField :: r -> (a -> r, a) + +getField :: forall x r a . HasField x r a => r -> a +getField = snd . hasField @x -- Note: a.x = is getField @"x" a. + +setField :: forall x r a . HasField x r a => r -> a -> r +setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. + +-- 'Corge' has a '&&&' field of type 'Int' +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) +instance HasField "&&&" Corge Int where + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) + +main = do + let b = Corge { (&&&) = 12 }; + print $ (b.(&&&)) + -- Syntax error: Dot notation is not available for fields with + -- operator names ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordDotSyntax #-} + +data Foo = Foo { foo :: Int } + +main = do + let a = Foo { foo = 1 } + print $ (const "hello") a .foo + -- Syntax error: f r .x is illegal. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail4.hs:7:29: error: + parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -175,3 +175,6 @@ test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) test('RecordDotSyntaxFail0', normal, compile_fail, ['']) test('RecordDotSyntaxFail1', normal, compile_fail, ['']) +test('RecordDotSyntaxFail2', normal, compile_fail, ['']) +test('RecordDotSyntaxFail3', normal, compile_fail, ['']) +test('RecordDotSyntaxFail4', normal, compile_fail, ['']) ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -17,52 +17,52 @@ setField :: forall x r a . HasField x r a => r -> a -> r setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. -- 'Foo' has 'foo' field of type 'Bar' -data Foo = Foo {foo :: Bar} deriving (Show, Eq) +data Foo = Foo { foo :: Bar } deriving (Show, Eq) instance HasField "foo" Foo Bar where - hasField r = (\x -> case r of Foo{..} -> Foo {foo = x, ..}, foo r) + hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r) -- 'Bar' has a 'bar' field of type 'Baz' -data Bar = Bar {bar :: Baz} deriving (Show, Eq) +data Bar = Bar { bar :: Baz } deriving (Show, Eq) instance HasField "bar" Bar Baz where - hasField r = (\x -> case r of Bar{..} -> Bar {bar = x, ..}, bar r) + hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r) -- 'Baz' has a 'baz' field of type 'Quux' -data Baz = Baz {baz :: Quux} deriving (Show, Eq) +data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where - hasField r = (\x -> case r of Baz{..} -> Baz {baz = x, ..}, baz r) + hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) -- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux {quux :: Int} deriving (Show, Eq) +data Quux = Quux { quux :: Int } deriving (Show, Eq) instance HasField "quux" Quux Int where - hasField r = (\x -> case r of Quux{..} -> Quux {quux = x, ..}, quux r) + hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r) -- 'Corge' has a '&&&' field of type 'Int' -data Corge = Corge {(&&&) :: Int} deriving (Show, Eq) +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) instance HasField "&&&" Corge Int where - hasField r = (\x -> case r of Corge{..} -> Corge {(&&&) = x, ..}, (&&&) r) + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) -- Note : Dot notation is not available for fields with operator -- names. -- 'Grault' has two fields 'f' and 'g' of type 'Foo'. data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq) instance HasField "f" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {f = x, ..}, f r) + hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r) instance HasField "g" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {g = x, ..}, g r) + hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r) main = do - let a = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 42}}}} - let b = Corge{(&&&) = 12}; + let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } + let b = Corge{ (&&&) = 12 }; let c = Grault { - f = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - , g = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - } + f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + } -- A "selector" is an expression like '(.a)' or '(.a.b)'. putStrLn "-- selectors:" - print $ (.foo) a -- Bar {bar = Baz {baz = Quux {quux = 42}}} - print $ (.foo.bar) a -- Baz {baz = Quux {quux = 42}} - print $ (.foo.bar.baz) a -- Quux {quux = 42} + print $ (.foo) a -- Bar { bar = Baz { baz = Quux { quux = 42 } } } + print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } } + print $ (.foo.bar.baz) a -- Quux { quux = 42 } print $ (.foo.bar.baz.quux) a -- 42 print $ ((&&&) b) -- 12 -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’ @@ -71,9 +71,9 @@ main = do -- A "selection" is an expression like 'r.a' or '(f r).a.b'. putStrLn "-- selections:" print $ a.foo.bar.baz.quux -- 42 - print $ a.foo.bar.baz -- Quux {quux = 42} - print $ a.foo.bar -- Baz {baz = Quux {quux = 42}} - print $ a.foo -- Bar {bar = Baz {baz = Quux {quux = 42}}} + print $ a.foo.bar.baz -- Quux { quux = 42 } + print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } } + print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } } print $ (const "hello") a.foo -- f r.x means f (r.x) -- print $ f a .foo -- f r .x is illegal print $ (const "hello") (id a).foo -- f (g r).x means f ((g r).x) @@ -86,30 +86,30 @@ main = do print $ (+) (id a).foo.bar.baz.quux 1 -- 43 print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43 - -- An "update" is an expression like 'r{a.b = 12}'. + -- An "update" is an expression like 'r{ a.b = 12 }'. putStrLn "-- updates:" - print $ (a.foo.bar.baz) {quux = 2} -- Quux {quux = 2} - print $ (\b -> b{bar=Baz{baz=Quux{quux=1}}}) a.foo -- Bar {bar = Baz {baz = Quux {quux = 1}}} - let bar = Bar {bar = Baz {baz = Quux {quux = 44}}} - print $ a{foo.bar = Baz {baz = Quux {quux = 44}}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} - print $ a{foo.bar.baz = Quux {quux = 45}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} - print $ a{foo.bar.baz.quux = 46} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} - print $ c{f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4} -- Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} - - -- A "punned update" is an expression like 'r{a.b}' (where it is + print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 } + print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } } + let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } } + print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } } + print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } } + print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } } + print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } } + + -- A "punned update" is an expression like 'r{ a.b }' (where it is -- understood that 'b' is a variable binding in the environment of -- the field update - enabled only when the extension -- 'NamedFieldPuns' is in effect). putStrLn "-- punned updates:" - let quux = 102; baz = Quux {quux}; bar = Baz {baz}; foo = Bar {bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz.quux} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} - print $ c{f.foo, g.foo.bar.baz.quux = 4} -- Mix punned and explicit; 102, 4 + let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } } + print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4 f <- pure a g <- pure a - print $ c{f} -- 42, 1 - print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 + print $ c{ f } -- 42, 1 + print $ c{ f, g } -- 42, 42 + print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f035d397194d972b93d5b4eed6334164f9d36891 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f035d397194d972b93d5b4eed6334164f9d36891 You're receiving 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 20 16:29:58 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Sun, 20 Sep 2020 12:29:58 -0400 Subject: [Git][ghc/ghc][wip/T18599] improve error reporting Message-ID: <5f6783862cc3e_80b3f842832b54013310743@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 8f012c12 by Shayne Fletcher at 2020-09-20T12:29:37-04:00 improve error reporting - - - - - 12 changed files: - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs - + testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr - testsuite/tests/parser/should_fail/all.T - testsuite/tests/parser/should_run/RecordDotSyntax.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Parser.Annotation +import Data.Either import Data.List import Data.Foldable import GHC.Driver.Session ( WarningFlag(..), DynFlags ) @@ -153,11 +154,14 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located (Located b -> Located b)) -fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) -fbindToRecField (Fbind f) = f -fbindToRecField _ = panic "fbindToRecField: The impossible happened" +fbindsToEithers :: [Fbind b] -> [Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b))] +fbindsToEithers = fmap fbindToEither + where + fbindToEither :: Fbind b -> Either (LHsRecField GhcPs (Located b)) (Located (Located b -> Located b)) + fbindToEither (Fbind x) = Left x + fbindToEither (Pbind x) = Right x {- ********************************************************************** @@ -1393,7 +1397,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 :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located (Located b -> Located b)) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1525,7 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV l _ _ = - cmdFail l $ - text "Field selector syntax is not supported in commands." + mkHsFieldUpdaterPV l _ _ = cmdFail l (text "Use of RecordDotSyntax `.' not valid.") 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 @@ -1557,8 +1559,12 @@ instance DisambECP (HsCmd GhcPs) where mkHsExplicitListPV l xs = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) mkHsSplicePV (L l sp) = cmdFail l (ppr sp) - mkHsRecordPV _ l _ a (fbinds, ddLoc) = cmdFail l $ - ppr a <+> ppr (mk_rec_fields fbinds ddLoc) + mkHsRecordPV _ l _ a (fbinds, ddLoc) = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else cmdFail l $ ppr a <+> ppr (mk_rec_fields fs ddLoc) mkHsNegAppPV l a = cmdFail l (text "-" <> ppr a) mkHsSectionR_PV l op c = cmdFail l $ let pp_op = fromMaybe (panic "cannot print infix operator") @@ -1587,7 +1593,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV l fields arg = return $ mkFieldUpdater l 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 @@ -1677,7 +1683,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field selector syntax is not supported in patterns." + text "Use of RecordDotSyntax `.' not valid." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." @@ -1709,8 +1715,13 @@ instance DisambECP (PatBuilder GhcPs) where return (L l (PatBuilderPat (ListPat noExtField ps))) mkHsSplicePV (L l sp) = return $ L l (PatBuilderPat (SplicePat noExtField sp)) mkHsRecordPV _ l _ a (fbinds, ddLoc) = do - r <- mkPatRec a (mk_rec_fields fbinds ddLoc) - checkRecordSyntax (L l r) + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text " Use of RecordDotSyntax `.' not valid.") + else do + r <- mkPatRec a (mk_rec_fields fs ddLoc) + checkRecordSyntax (L l r) mkHsNegAppPV l (L lp p) = do lit <- case p of PatBuilderOverLit pos_lit -> return (L lp pos_lit) @@ -2352,20 +2363,32 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) -mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fbinds,dd) | isRdrDataCon c - = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) + = do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then addFatalError (getLoc (head ps)) + (text "Use of RecordDotSyntax `.' not valid.") + else 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 fs) + | otherwise = mkRdrRecordUpd' dot exp fs -mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs -mkRdrRecordUpd' dot exp fbinds = +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> PV (HsExpr GhcPs) +mkRdrRecordUpd' dot exp@(L lexp _) fbinds = if not dot - then - mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) - else - foldl' fieldUpdate (unLoc exp) fbinds + then do + let (fs, ps) = partitionEithers $ fbindsToEithers fbinds + if not (null ps) + then + -- If RecordDotSyntax is not enabled (as indicated by the + -- value of 'dot'), then the lexer can't ever issue an ITproj + -- token and so this case is refuted. + panic "mkRdrRecordUpd': The impossible happened!" + else return $ mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs) + else + return $ foldl' fieldUpdate (unLoc exp) fbinds where fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs fieldUpdate acc f = @@ -2374,7 +2397,7 @@ mkRdrRecordUpd' dot exp fbinds = Fbind field -> let updField = fmap mk_rec_upd_field field in unLoc $ foldl' mkSetField (noLoc acc) [updField] - Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + Pbind (L _ fieldUpdater) -> unLoc (fieldUpdater (noLoc acc)) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds @@ -2386,12 +2409,9 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds } - - -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 :: [LHsRecField GhcPs (Located b)] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) +mk_rec_fields flds Nothing = HsRecFields { rec_flds = flds, rec_dotdot = Nothing } +mk_rec_fields flds (Just s) = HsRecFields { rec_flds = flds, rec_dotdot = Just (L s (length flds)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) @@ -2983,8 +3003,9 @@ mkSet :: LHsExpr GhcPs -> Located FastString -> LHsExpr GhcPs -> LHsExpr GhcPs mkSet a (L _ fIELD) b = set_field `mkAppType` mkSelector fIELD `mkApp` a `mkApp` b -- mkFieldUpdater calculates functions representing dot notation record updates. -mkFieldUpdater :: [Located FastString] -> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs) +mkFieldUpdater :: SrcSpan -> [Located FastString] -> LHsExpr GhcPs -> Located (LHsExpr GhcPs -> LHsExpr GhcPs) mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} + l fIELDS -- [foo, bar, baz, quux] arg -- This is 'texp' (43 in the example). = let { @@ -2995,7 +3016,7 @@ mkFieldUpdater -- e.g {foo.bar.baz.quux = 43} ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] } - in \a -> foldl' mkSet' arg (zips a) + in L l $ \a -> foldl' mkSet' arg (zips a) -- setField@"foo" (a) (setField@"bar" (getField @"foo" (a))(setField@"baz" (getField @"bar" (getField @"foo" (a)))(setField@"quux" (getField @"baz" (getField @"bar" (getField @"foo" (a))))(quux)))) where mkSet' :: LHsExpr GhcPs -> (Located FastString, LHsExpr GhcPs) -> LHsExpr GhcPs ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail0.stderr ===================================== @@ -1,5 +1,2 @@ -ghc: panic! (the 'impossible' happened) - (GHC version 8.11.0.20200909: - fbindToRecField: The impossible happened - -Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug + RecordDotSyntaxFail0.hs:3:12: + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE RecordDotSyntax #-} no Foo { bar.baz = x } = undefined - -- Syntax error: "Field selector syntax is not supported in - -- patterns." + -- Syntax error: Field selector syntax doesn't participate + -- in patterns ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail1.stderr ===================================== @@ -1,2 +1,2 @@ RecordDotSyntaxFail1.hs:3:10: - Field selector syntax is not supported in patterns. + Use of RecordDotSyntax `.' not valid. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoRecordDotSyntax #-} + +data Foo = Foo { foo :: Bar } +data Bar = Bar { bar :: Baz } +data Baz = Baz { baz :: Quux } +data Quux = Quux { quux :: Int } + +no :: Foo -> Foo +no = Foo { bar.baz = Quux { quux = 42 } } } } + -- Syntax error: RecordDotSyntax is not enabled ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail2.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail2.hs:9:15: parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE AllowAmbiguousTypes, FunctionalDependencies, ScopedTypeVariables, PolyKinds, TypeApplications, DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordDotSyntax #-} + +class HasField x r a | x r -> a where + hasField :: r -> (a -> r, a) + +getField :: forall x r a . HasField x r a => r -> a +getField = snd . hasField @x -- Note: a.x = is getField @"x" a. + +setField :: forall x r a . HasField x r a => r -> a -> r +setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. + +-- 'Corge' has a '&&&' field of type 'Int' +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) +instance HasField "&&&" Corge Int where + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) + +main = do + let b = Corge { (&&&) = 12 }; + print $ (b.(&&&)) + -- Syntax error: Dot notation is not available for fields with + -- operator names ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail3.stderr ===================================== @@ -0,0 +1 @@ +RecordDotSyntaxFail3.hs:22:14: parse error on input ‘(’ ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE RecordDotSyntax #-} + +data Foo = Foo { foo :: Int } + +main = do + let a = Foo { foo = 1 } + print $ (const "hello") a .foo + -- Syntax error: f r .x is illegal. ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail4.stderr ===================================== @@ -0,0 +1,2 @@ +RecordDotSyntaxFail4.hs:7:29: error: + parse error on input ‘.’ ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -175,3 +175,6 @@ test('T18251e', normal, compile_fail, ['']) test('T18251f', normal, compile_fail, ['']) test('RecordDotSyntaxFail0', normal, compile_fail, ['']) test('RecordDotSyntaxFail1', normal, compile_fail, ['']) +test('RecordDotSyntaxFail2', normal, compile_fail, ['']) +test('RecordDotSyntaxFail3', normal, compile_fail, ['']) +test('RecordDotSyntaxFail4', normal, compile_fail, ['']) ===================================== testsuite/tests/parser/should_run/RecordDotSyntax.hs ===================================== @@ -17,52 +17,52 @@ setField :: forall x r a . HasField x r a => r -> a -> r setField = fst . hasField @x -- Note : a{x = b} is setField @"x" a b. -- 'Foo' has 'foo' field of type 'Bar' -data Foo = Foo {foo :: Bar} deriving (Show, Eq) +data Foo = Foo { foo :: Bar } deriving (Show, Eq) instance HasField "foo" Foo Bar where - hasField r = (\x -> case r of Foo{..} -> Foo {foo = x, ..}, foo r) + hasField r = (\x -> case r of Foo { .. } -> Foo { foo = x, .. }, foo r) -- 'Bar' has a 'bar' field of type 'Baz' -data Bar = Bar {bar :: Baz} deriving (Show, Eq) +data Bar = Bar { bar :: Baz } deriving (Show, Eq) instance HasField "bar" Bar Baz where - hasField r = (\x -> case r of Bar{..} -> Bar {bar = x, ..}, bar r) + hasField r = (\x -> case r of Bar { .. } -> Bar { bar = x, .. }, bar r) -- 'Baz' has a 'baz' field of type 'Quux' -data Baz = Baz {baz :: Quux} deriving (Show, Eq) +data Baz = Baz { baz :: Quux } deriving (Show, Eq) instance HasField "baz" Baz Quux where - hasField r = (\x -> case r of Baz{..} -> Baz {baz = x, ..}, baz r) + hasField r = (\x -> case r of Baz { .. } -> Baz { baz = x, .. }, baz r) -- 'Quux' has a 'quux' field of type 'Int' -data Quux = Quux {quux :: Int} deriving (Show, Eq) +data Quux = Quux { quux :: Int } deriving (Show, Eq) instance HasField "quux" Quux Int where - hasField r = (\x -> case r of Quux{..} -> Quux {quux = x, ..}, quux r) + hasField r = (\x -> case r of Quux { .. } -> Quux { quux = x, .. }, quux r) -- 'Corge' has a '&&&' field of type 'Int' -data Corge = Corge {(&&&) :: Int} deriving (Show, Eq) +data Corge = Corge { (&&&) :: Int } deriving (Show, Eq) instance HasField "&&&" Corge Int where - hasField r = (\x -> case r of Corge{..} -> Corge {(&&&) = x, ..}, (&&&) r) + hasField r = (\x -> case r of Corge { .. } -> Corge { (&&&) = x, .. }, (&&&) r) -- Note : Dot notation is not available for fields with operator -- names. -- 'Grault' has two fields 'f' and 'g' of type 'Foo'. data Grault = Grault {f :: Foo, g :: Foo} deriving (Show, Eq) instance HasField "f" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {f = x, ..}, f r) + hasField r = (\x -> case r of Grault { .. } -> Grault { f = x, .. }, f r) instance HasField "g" Grault Foo where - hasField r = (\x -> case r of Grault{..} -> Grault {g = x, ..}, g r) + hasField r = (\x -> case r of Grault { .. } -> Grault { g = x, .. }, g r) main = do - let a = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 42}}}} - let b = Corge{(&&&) = 12}; + let a = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 42 } } } } + let b = Corge{ (&&&) = 12 }; let c = Grault { - f = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - , g = Foo {foo = Bar{bar = Baz {baz = Quux {quux = 1}}}} - } + f = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + , g = Foo { foo = Bar{ bar = Baz { baz = Quux { quux = 1 } } } } + } -- A "selector" is an expression like '(.a)' or '(.a.b)'. putStrLn "-- selectors:" - print $ (.foo) a -- Bar {bar = Baz {baz = Quux {quux = 42}}} - print $ (.foo.bar) a -- Baz {baz = Quux {quux = 42}} - print $ (.foo.bar.baz) a -- Quux {quux = 42} + print $ (.foo) a -- Bar { bar = Baz { baz = Quux { quux = 42 } } } + print $ (.foo.bar) a -- Baz { baz = Quux { quux = 42 } } + print $ (.foo.bar.baz) a -- Quux { quux = 42 } print $ (.foo.bar.baz.quux) a -- 42 print $ ((&&&) b) -- 12 -- print $ (b.(&&&)) -- illegal : parse error on input ‘(’ @@ -71,9 +71,9 @@ main = do -- A "selection" is an expression like 'r.a' or '(f r).a.b'. putStrLn "-- selections:" print $ a.foo.bar.baz.quux -- 42 - print $ a.foo.bar.baz -- Quux {quux = 42} - print $ a.foo.bar -- Baz {baz = Quux {quux = 42}} - print $ a.foo -- Bar {bar = Baz {baz = Quux {quux = 42}}} + print $ a.foo.bar.baz -- Quux { quux = 42 } + print $ a.foo.bar -- Baz { baz = Quux { quux = 42 } } + print $ a.foo -- Bar { bar = Baz { baz = Quux { quux = 42 } } } print $ (const "hello") a.foo -- f r.x means f (r.x) -- print $ f a .foo -- f r .x is illegal print $ (const "hello") (id a).foo -- f (g r).x means f ((g r).x) @@ -86,30 +86,30 @@ main = do print $ (+) (id a).foo.bar.baz.quux 1 -- 43 print $ (+) ((id a).foo.bar & (.baz.quux)) 1 -- 43 - -- An "update" is an expression like 'r{a.b = 12}'. + -- An "update" is an expression like 'r{ a.b = 12 }'. putStrLn "-- updates:" - print $ (a.foo.bar.baz) {quux = 2} -- Quux {quux = 2} - print $ (\b -> b{bar=Baz{baz=Quux{quux=1}}}) a.foo -- Bar {bar = Baz {baz = Quux {quux = 1}}} - let bar = Bar {bar = Baz {baz = Quux {quux = 44}}} - print $ a{foo.bar = Baz {baz = Quux {quux = 44}}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 44}}}} - print $ a{foo.bar.baz = Quux {quux = 45}} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 45}}}} - print $ a{foo.bar.baz.quux = 46} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 46}}}} - print $ c{f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4} -- Grault {f = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 3}}}}, g = Foo {foo = Bar {bar = Baz {baz = Quux {quux = 4}}}}} - - -- A "punned update" is an expression like 'r{a.b}' (where it is + print $ (a.foo.bar.baz) { quux = 2 } -- Quux { quux = 2 } + print $ (\b -> b{ bar=Baz{ baz=Quux{ quux=1 } } }) a.foo -- Bar { bar = Baz { baz = Quux { quux = 1 } } } + let bar = Bar { bar = Baz { baz = Quux { quux = 44 } } } + print $ a{ foo.bar = Baz { baz = Quux { quux = 44 } } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 44 } } } } + print $ a{ foo.bar.baz = Quux { quux = 45 } } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 45 } } } } + print $ a{ foo.bar.baz.quux = 46 } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 46 } } } } + print $ c{ f.foo.bar.baz.quux = 3, g.foo.bar.baz.quux = 4 } -- Grault { f = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 3 } } } }, g = Foo { foo = Bar { bar = Baz { baz = Quux { quux = 4 } } } } } + + -- A "punned update" is an expression like 'r{ a.b }' (where it is -- understood that 'b' is a variable binding in the environment of -- the field update - enabled only when the extension -- 'NamedFieldPuns' is in effect). putStrLn "-- punned updates:" - let quux = 102; baz = Quux {quux}; bar = Baz {baz}; foo = Bar {bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz.quux} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar.baz} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo.bar} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a{foo} -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 102}}}} - print $ a -- Foo {foo = Bar {bar = Baz {baz = Quux {quux = 42}}}} - print $ c{f.foo, g.foo.bar.baz.quux = 4} -- Mix punned and explicit; 102, 4 + let quux = 102; baz = Quux { quux }; bar = Baz { baz }; foo = Bar { bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz.quux } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar.baz } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo.bar } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a{ foo } -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 102 } } } } + print $ a -- Foo { foo = Bar { bar = Baz { baz = Quux { quux = 42 } } } } + print $ c{ f.foo, g.foo.bar.baz.quux = 4 } -- Mix punned and explicit; 102, 4 f <- pure a g <- pure a - print $ c{f} -- 42, 1 - print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Mix top-level and nested updates; 42, 4 + print $ c{ f } -- 42, 1 + print $ c{ f, g } -- 42, 42 + print $ c{ f, g.foo.bar.baz.quux = 4 } -- Mix top-level and nested updates; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f012c120c5f0f7eca2016600b5d312750158a4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f012c120c5f0f7eca2016600b5d312750158a4c You're receiving 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 20 18:29:38 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 20 Sep 2020 14:29:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/ghc-9.0-anns-2 Message-ID: <5f679f9280a9d_80b10d983ec1332089@gitlab.haskell.org.mail> Alan Zimmerman pushed new branch wip/az/ghc-9.0-anns-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/ghc-9.0-anns-2 You're receiving 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 20 19:30:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 20 Sep 2020 15:30:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 24 commits: Require happy >=1.20 Message-ID: <5f67add1b2583_80b3f849c388438133391c4@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - aef77d0d by Ben Gamari at 2020-09-20T15:30:18-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 892442b0 by Ben Gamari at 2020-09-20T15:30:18-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 64565c21 by Ben Gamari at 2020-09-20T15:30:18-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - 5736b6d5 by Ben Gamari at 2020-09-20T15:30:18-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - cb84bf6a by Ben Gamari at 2020-09-20T15:30:18-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - 1c462c0e by GHC GitLab CI at 2020-09-20T15:30:18-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 31335352 by GHC GitLab CI at 2020-09-20T15:30:18-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - c5aea7e6 by GHC GitLab CI at 2020-09-20T15:30:18-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 30 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Misc.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 - docs/users_guide/release-notes.rst - docs/users_guide/runtime_control.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/GHCi/UI/Monad.hs - ghc/ghc-bin.cabal.in - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Rules/Documentation.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfde7611fc5f34c35377c6f48d6b6fe904fb62d2...c5aea7e6ce54caa7687af88c5dabb5caf16da874 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cfde7611fc5f34c35377c6f48d6b6fe904fb62d2...c5aea7e6ce54caa7687af88c5dabb5caf16da874 You're receiving 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 20 21:08:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 20 Sep 2020 17:08:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/stack-hadrian Message-ID: <5f67c4d056e77_80b764c8a8133409ac@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/stack-hadrian at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/stack-hadrian You're receiving 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 21 00:30:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 20 Sep 2020 20:30:30 -0400 Subject: [Git][ghc/ghc][master] Resolve shift/reduce conflicts with %shift (#17232) Message-ID: <5f67f4265bbd2_80bb4247481335755a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -95,297 +95,398 @@ import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nil manyDataConTyCon) } -%expect 232 -- shift/reduce conflicts +%expect 0 -- shift/reduce conflicts -{- Last updated: 08 June 2020 +{- Note [shift/reduce conflicts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'happy' tool turns this grammar into an efficient parser that follows the +shift-reduce parsing model. There's a parse stack that contains items parsed so +far (both terminals and non-terminals). Every next token produced by the lexer +results in one of two actions: -If you modify this parser and add a conflict, please update this comment. -You can learn more about the conflicts by passing 'happy' the -i flag: + SHIFT: push the token onto the parse stack - happy -agc --strict compiler/GHC/Parser.y -idetailed-info + REDUCE: pop a few items off the parse stack and combine them + with a function (reduction rule) -How is this section formatted? Look up the state the conflict is -reported at, and copy the list of applicable rules (at the top, without the -rule numbers). Mark *** for the rule that is the conflicting reduction (that -is, the interpretation which is NOT taken). NB: Happy doesn't print a rule -in a state if it is empty, but you should include it in the list (you can -look these up in the Grammar section of the info file). +However, sometimes it's unclear which of the two actions to take. +Consider this code example: -Obviously the state numbers are not stable across modifications to the parser, -the idea is to reproduce enough information on each conflict so you can figure -out what happened if the states were renumbered. Try not to gratuitously move -productions around in this file. + if x then y else f z -------------------------------------------------------------------------------- - -state 60 contains 1 shift/reduce conflict. - - context -> btype . - *** type -> btype . - type -> btype . '->' ctype - - Conflicts: '->' - -------------------------------------------------------------------------------- - -state 61 contains 46 shift/reduce conflicts. - - *** btype -> tyapps . - tyapps -> tyapps . tyapp - - Conflicts: '_' ':' '~' '!' '.' '`' '{' '[' '(' '(#' '`' TYPEAPP - SIMPLEQUOTE VARID CONID VARSYM CONSYM QCONID QVARSYM QCONSYM - STRING INTEGER TH_ID_SPLICE '$(' TH_QUASIQUOTE TH_QQUASIQUOTE - and all the special ids. - -Example ambiguity: - 'if x then y else z :: F a' - -Shift parses as (per longest-parse rule): - 'if x then y else z :: (F a)' - -------------------------------------------------------------------------------- - -state 143 contains 14 shift/reduce conflicts. - - exp -> infixexp . '::' sigtype - exp -> infixexp . '-<' exp - exp -> infixexp . '>-' exp - exp -> infixexp . '-<<' exp - exp -> infixexp . '>>-' exp - *** exp -> infixexp . - infixexp -> infixexp . qop exp10 - - Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-' - '.' '`' '*' VARSYM CONSYM QVARSYM QCONSYM - -Examples of ambiguity: - 'if x then y else z -< e' - 'if x then y else z :: T' - 'if x then y else z + 1' (NB: '+' is in VARSYM) - -Shift parses as (per longest-parse rule): - 'if x then y else (z -< T)' - 'if x then y else (z :: T)' - 'if x then y else (z + 1)' - -------------------------------------------------------------------------------- +There are two ways to parse it: -state 146 contains 66 shift/reduce conflicts. + (if x then y else f) z + if x then y else (f z) - *** exp10 -> fexp . - fexp -> fexp . aexp - fexp -> fexp . TYPEAPP atype +How is this determined? At some point, the parser gets to the following state: - Conflicts: TYPEAPP and all the tokens that can start an aexp + parse stack: 'if' exp 'then' exp 'else' "f" + next token: "z" -Examples of ambiguity: - 'if x then y else f z' - 'if x then y else f @ z' +Scenario A (simplified): -Shift parses as (per longest-parse rule): - 'if x then y else (f z)' - 'if x then y else (f @ z)' + 1. REDUCE, parse stack: 'if' exp 'then' exp 'else' exp + next token: "z" + (Note that "f" reduced to exp here) -------------------------------------------------------------------------------- + 2. REDUCE, parse stack: exp + next token: "z" -state 200 contains 27 shift/reduce conflicts. + 3. SHIFT, parse stack: exp "z" + next token: ... - aexp2 -> TH_TY_QUOTE . tyvar - aexp2 -> TH_TY_QUOTE . gtycon - *** aexp2 -> TH_TY_QUOTE . + 4. REDUCE, parse stack: exp + next token: ... - Conflicts: two single quotes is error syntax with specific error message. + This way we get: (if x then y else f) z -Example of ambiguity: - 'x = ''' - 'x = ''a' - 'x = ''T' +Scenario B (simplified): -Shift parses as (per longest-parse rule): - 'x = ''a' - 'x = ''T' + 1. SHIFT, parse stack: 'if' exp 'then' exp 'else' "f" "z" + next token: ... -------------------------------------------------------------------------------- + 2. REDUCE, parse stack: 'if' exp 'then' exp 'else' exp + next token: ... -state 294 contains 1 shift/reduce conflicts. + 3. REDUCE, parse stack: exp + next token: ... - rule -> STRING . rule_activation rule_forall infixexp '=' exp + This way we get: if x then y else (f z) - Conflict: '[' (empty rule_activation reduces) +The end result is determined by the chosen action. When Happy detects this, it +reports a shift/reduce conflict. At the top of the file, we have the following +directive: -We don't know whether the '[' starts the activation or not: it -might be the start of the declaration with the activation being -empty. --SDM 1/4/2002 + %expect 0 -Example ambiguity: - '{-# RULE [0] f = ... #-}' +It means that we expect no unresolved shift/reduce conflicts in this grammar. +If you modify the grammar and get shift/reduce conflicts, follow the steps +below to resolve them. -We parse this as having a [0] rule activation for rewriting 'f', rather -a rule instructing how to rewrite the expression '[0] f'. +STEP ONE + is to figure out what causes the conflict. + That's where the -i flag comes in handy: -------------------------------------------------------------------------------- + happy -agc --strict compiler/GHC/Parser.y -idetailed-info -state 305 contains 1 shift/reduce conflict. + By analysing the output of this command, in a new file `detailed-info`, you + can figure out which reduction rule causes the issue. At the top of the + generated report, you will see a line like this: - *** type -> btype . - type -> btype . '->' ctype + state 147 contains 67 shift/reduce conflicts. - Conflict: '->' + Scroll down to section State 147 (in your case it could be a different + state). The start of the section lists the reduction rules that can fire + and shows their context: -Same as state 61 but without contexts. + exp10 -> fexp . (rule 492) + fexp -> fexp . aexp (rule 498) + fexp -> fexp . PREFIX_AT atype (rule 499) -------------------------------------------------------------------------------- + And then, for every token, it tells you the parsing action: -state 349 contains 1 shift/reduce conflicts. + ']' reduce using rule 492 + '::' reduce using rule 492 + '(' shift, and enter state 178 + QVARID shift, and enter state 44 + DO shift, and enter state 182 + ... - tup_exprs -> commas . tup_tail - sysdcon_nolist -> '(' commas . ')' - commas -> commas . ',' + But if you look closer, some of these tokens also have another parsing action + in parentheses: - Conflict: ')' (empty tup_tail reduces) + QVARID shift, and enter state 44 + (reduce using rule 492) -A tuple section with NO free variables '(,,)' is indistinguishable -from the Haskell98 data constructor for a tuple. Shift resolves in -favor of sysdcon, which is good because a tuple section will get rejected -if -XTupleSections is not specified. + That's how you know rule 492 is causing trouble. + Scroll back to the top to see what this rule is: -See also Note [ExplicitTuple] in GHC.Hs.Expr. + ---------------------------------- + Grammar + ---------------------------------- + ... + ... + exp10 -> fexp (492) + optSemi -> ';' (493) + ... + ... -------------------------------------------------------------------------------- + Hence the shift/reduce conflict is caused by this parser production: -state 407 contains 1 shift/reduce conflicts. + exp10 :: { ECP } + : '-' fexp { ... } + | fexp { ... } -- problematic rule - tup_exprs -> commas . tup_tail - sysdcon_nolist -> '(#' commas . '#)' - commas -> commas . ',' +STEP TWO + is to mark the problematic rule with the %shift pragma. This signals to + 'happy' that any shift/reduce conflicts involving this rule must be resolved + in favor of a shift. There's currently no dedicated pragma to resolve in + favor of the reduce. - Conflict: '#)' (empty tup_tail reduces) +STEP THREE + is to add a dedicated Note for this specific conflict, as is done for all + other conflicts below. +-} -Same as State 354 for unboxed tuples. +{- Note [%shift: rule_activation -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule -> STRING . rule_activation rule_foralls infixexp '=' exp -------------------------------------------------------------------------------- +Example: + {-# RULES "name" [0] f = rhs #-} -state 416 contains 66 shift/reduce conflicts. +Ambiguity: + If we reduced, then we'd get an empty activation rule, and [0] would be + parsed as part of the left-hand side expression. - *** exp10 -> '-' fexp . - fexp -> fexp . aexp - fexp -> fexp . TYPEAPP atype + We shift, so [0] is parsed as an activation rule. +-} -Same as 146 but with a unary minus. +{- Note [%shift: rule_foralls -> 'forall' rule_vars '.'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule_foralls -> 'forall' rule_vars '.' . 'forall' rule_vars '.' + rule_foralls -> 'forall' rule_vars '.' . -------------------------------------------------------------------------------- +Example: + {-# RULES "name" forall a1. forall a2. lhs = rhs #-} -state 472 contains 1 shift/reduce conflict. +Ambiguity: + Same as in Note [%shift: rule_foralls -> {- empty -}] + but for the second 'forall'. +-} - oqtycon -> '(' qtyconsym . ')' - *** qtyconop -> qtyconsym . +{- Note [%shift: rule_foralls -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule -> STRING rule_activation . rule_foralls infixexp '=' exp - Conflict: ')' +Example: + {-# RULES "name" forall a1. lhs = rhs #-} -Example ambiguity: 'foo :: (:%)' +Ambiguity: + If we reduced, then we would get an empty rule_foralls; the 'forall', being + a valid term-level identifier, would be parsed as part of the left-hand + side expression. -Shift means '(:%)' gets parsed as a type constructor, rather than than a -parenthesized infix type expression of length 1. + We shift, so the 'forall' is parsed as part of rule_foralls. +-} -------------------------------------------------------------------------------- +{- Note [%shift: type -> btype] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + context -> btype . + type -> btype . + type -> btype . '->' ctype + type -> btype . '#->' ctype -state 665 contains 1 shift/reduce conflicts. +Example: + a :: Maybe Integer -> Bool - *** aexp2 -> ipvar . - dbind -> ipvar . '=' exp +Ambiguity: + If we reduced, we would get: (a :: Maybe Integer) -> Bool + We shift to get this instead: a :: (Maybe Integer -> Bool) +-} - Conflict: '=' +{- Note [%shift: infixtype -> ftype] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + infixtype -> ftype . + infixtype -> ftype . tyop infixtype + ftype -> ftype . tyarg + ftype -> ftype . PREFIX_AT tyarg + +Example: + a :: Maybe Integer + +Ambiguity: + If we reduced, we would get: (a :: Maybe) Integer + We shift to get this instead: a :: (Maybe Integer) +-} -Example ambiguity: 'let ?x ...' +{- Note [%shift: atype -> tyvar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + atype -> tyvar . + tv_bndr_no_braces -> '(' tyvar . '::' kind ')' -The parser can't tell whether the ?x is the lhs of a normal binding or -an implicit binding. Fortunately, resolving as shift gives it the only -sensible meaning, namely the lhs of an implicit binding. +Example: + class C a where type D a = (a :: Type ... -------------------------------------------------------------------------------- +Ambiguity: + If we reduced, we could specify a default for an associated type like this: -state 750 contains 1 shift/reduce conflicts. + class C a where type D a + type D a = (a :: Type) - rule -> STRING rule_activation . rule_forall infixexp '=' exp + But we shift in order to allow injectivity signatures like this: - Conflict: 'forall' (empty rule_forall reduces) + class C a where type D a = (r :: Type) | r -> a +-} -Example ambiguity: '{-# RULES "name" forall = ... #-}' +{- Note [%shift: exp -> infixexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp -> infixexp . '::' sigtype + exp -> infixexp . '-<' exp + exp -> infixexp . '>-' exp + exp -> infixexp . '-<<' exp + exp -> infixexp . '>>-' exp + exp -> infixexp . + infixexp -> infixexp . qop exp10p + +Examples: + 1) if x then y else z -< e + 2) if x then y else z :: T + 3) if x then y else z + 1 -- (NB: '+' is in VARSYM) + +Ambiguity: + If we reduced, we would get: + + 1) (if x then y else z) -< e + 2) (if x then y else z) :: T + 3) (if x then y else z) + 1 + + We shift to get this instead: + + 1) if x then y else (z -< e) + 2) if x then y else (z :: T) + 3) if x then y else (z + 1) +-} -'forall' is a valid variable name---we don't know whether -to treat a forall on the input as the beginning of a quantifier -or the beginning of the rule itself. Resolving to shift means -it's always treated as a quantifier, hence the above is disallowed. -This saves explicitly defining a grammar for the rule lhs that -doesn't include 'forall'. +{- Note [%shift: exp10 -> '-' fexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp10 -> '-' fexp . + fexp -> fexp . aexp + fexp -> fexp . PREFIX_AT atype -------------------------------------------------------------------------------- +Examples & Ambiguity: + Same as in Note [%shift: exp10 -> fexp], + but with a '-' in front. +-} -state 986 contains 1 shift/reduce conflicts. +{- Note [%shift: exp10 -> fexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp10 -> fexp . + fexp -> fexp . aexp + fexp -> fexp . PREFIX_AT atype - transformqual -> 'then' 'group' . 'using' exp - transformqual -> 'then' 'group' . 'by' exp 'using' exp - *** special_id -> 'group' . +Examples: + 1) if x then y else f z + 2) if x then y else f @z - Conflict: 'by' +Ambiguity: + If we reduced, we would get: -------------------------------------------------------------------------------- + 1) (if x then y else f) z + 2) (if x then y else f) @z -state 1084 contains 1 shift/reduce conflicts. + We shift to get this instead: - rule_foralls -> 'forall' rule_vars '.' . 'forall' rule_vars '.' - *** rule_foralls -> 'forall' rule_vars '.' . + 1) if x then y else (f z) + 2) if x then y else (f @z) +-} - Conflict: 'forall' +{- Note [%shift: aexp2 -> ipvar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + aexp2 -> ipvar . + dbind -> ipvar . '=' exp -Example ambiguity: '{-# RULES "name" forall a. forall ... #-}' +Example: + let ?x = ... -Here the parser cannot tell whether the second 'forall' is the beginning of -a term-level quantifier, for example: +Ambiguity: + If we reduced, ?x would be parsed as the LHS of a normal binding, + eventually producing an error. -'{-# RULES "name" forall a. forall x. id @a x = x #-}' + We shift, so it is parsed as the LHS of an implicit binding. +-} -or a valid variable named 'forall', for example a function @:: Int -> Int@ +{- Note [%shift: aexp2 -> TH_TY_QUOTE] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + aexp2 -> TH_TY_QUOTE . tyvar + aexp2 -> TH_TY_QUOTE . gtycon + aexp2 -> TH_TY_QUOTE . -'{-# RULES "name" forall a. forall 0 = 0 #-}' +Examples: + 1) x = '' + 2) x = ''a + 3) x = ''T -Shift means the parser only allows the former. Also see conflict 753 above. +Ambiguity: + If we reduced, the '' would result in reportEmptyDoubleQuotes even when + followed by a type variable or a type constructor. But the only reason + this reduction rule exists is to improve error messages. -------------------------------------------------------------------------------- + Naturally, we shift instead, so that ''a and ''T work as expected. +-} -state 1285 contains 1 shift/reduce conflict. +{- Note [%shift: tup_tail -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + tup_exprs -> commas . tup_tail + sysdcon_nolist -> '(' commas . ')' + sysdcon_nolist -> '(#' commas . '#)' + commas -> commas . ',' - constrs1 -> constrs1 maybe_docnext '|' . maybe_docprev constr +Example: + (,,) - Conflict: DOCPREV +Ambiguity: + A tuple section with no components is indistinguishable from the Haskell98 + data constructor for a tuple. -------------------------------------------------------------------------------- + If we reduced, (,,) would be parsed as a tuple section. + We shift, so (,,) is parsed as a data constructor. -state 1375 contains 1 shift/reduce conflict. + This is preferable because we want to accept (,,) without -XTupleSections. + See also Note [ExplicitTuple] in GHC.Hs.Expr. +-} - *** atype -> tyvar . - tv_bndr -> '(' tyvar . '::' kind ')' +{- Note [%shift: qtyconop -> qtyconsym] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + oqtycon -> '(' qtyconsym . ')' + qtyconop -> qtyconsym . - Conflict: '::' +Example: + foo :: (:%) -Example ambiguity: 'class C a where type D a = ( a :: * ...' +Ambiguity: + If we reduced, (:%) would be parsed as a parenthehsized infix type + expression without arguments, resulting in the 'failOpFewArgs' error. -Here the parser cannot tell whether this is specifying a default for the -associated type like: + We shift, so it is parsed as a type constructor. +-} -'class C a where type D a = ( a :: * ); type D a' +{- Note [%shift: special_id -> 'group'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + transformqual -> 'then' 'group' . 'using' exp + transformqual -> 'then' 'group' . 'by' exp 'using' exp + special_id -> 'group' . -or it is an injectivity signature like: +Example: + [ ... | then group by dept using groupWith + , then take 5 ] -'class C a where type D a = ( r :: * ) | r -> a' +Ambiguity: + If we reduced, 'group' would be parsed as a term-level identifier, just as + 'take' in the other clause. -Shift means the parser only allows the latter. + We shift, so it is parsed as part of the 'group by' clause introduced by + the -XTransformListComp extension. +-} -------------------------------------------------------------------------------- --- API Annotations --- +{- Note [Parser API Annotations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A lot of the productions are now cluttered with calls to aa,am,ams,amms etc. @@ -405,9 +506,10 @@ If you modify the parser and want to ensure that the API annotations are process correctly, see the README in (REPO)/utils/check-api-annotations for details on how to set up a test using the check-api-annotations utility, and interpret the output it generates. +-} -Note [Parsing lists] ---------------------- +{- Note [Parsing lists] +~~~~~~~~~~~~~~~~~~~~~~~ You might be wondering why we spend so much effort encoding our lists this way: @@ -447,9 +549,6 @@ are the most common patterns, rewritten as regular expressions for clarity: -- Equivalent to x (',' x)+ (non-empty, no trailing semis) xs : x | x ',' xs - --- ----------------------------------------------------------------------------- - -} %token @@ -1681,7 +1780,8 @@ rule :: { LRuleDecl GhcPs } -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas rule_activation :: { ([AddAnn],Maybe Activation) } - : {- empty -} { ([],Nothing) } + -- See Note [%shift: rule_activation -> {- empty -}] + : {- empty -} %shift { ([],Nothing) } | rule_explicit_activation { (fst $1,Just (snd $1)) } -- This production is used to parse the tilde syntax in pragmas such as @@ -1717,9 +1817,12 @@ rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) } >> return ([mu AnnForall $1,mj AnnDot $3, mu AnnForall $4,mj AnnDot $6], Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) } - | 'forall' rule_vars '.' { ([mu AnnForall $1,mj AnnDot $3], + + -- See Note [%shift: rule_foralls -> 'forall' rule_vars '.'] + | 'forall' rule_vars '.' %shift { ([mu AnnForall $1,mj AnnDot $3], Nothing, mkRuleBndrs $2) } - | {- empty -} { ([], Nothing, []) } + -- See Note [%shift: rule_foralls -> {- empty -}] + | {- empty -} %shift { ([], Nothing, []) } rule_vars :: { [LRuleTyTmVar] } : rule_var rule_vars { $1 : $2 } @@ -1953,7 +2056,8 @@ is connected to the first type too. -} type :: { LHsType GhcPs } - : btype { $1 } + -- See Note [%shift: type -> btype] + : btype %shift { $1 } | btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations] >> ams (sLL $1 $> $ HsFunTy noExtField HsUnrestrictedArrow $1 $3) [mu AnnRarrow $2] } @@ -1969,7 +2073,8 @@ btype :: { LHsType GhcPs } : infixtype {% runPV $1 } infixtype :: { forall b. DisambTD b => PV (Located b) } - : ftype { $1 } + -- See Note [%shift: infixtype -> ftype] + : ftype %shift { $1 } | ftype tyop infixtype { $1 >>= \ $1 -> $3 >>= \ $3 -> mkHsOpTyPV $1 $2 $3 } @@ -1998,7 +2103,8 @@ tyop :: { Located RdrName } atype :: { LHsType GhcPs } : ntgtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- Not including unit tuples - | tyvar { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples]) + -- See Note [%shift: atype -> tyvar] + | tyvar %shift { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } @@ -2482,7 +2588,8 @@ exp :: { ECP } ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1 HsHigherOrderApp False) [mu AnnRarrowtail $2] } - | infixexp { $1 } + -- See Note [%shift: exp -> infixexp] + | infixexp %shift { $1 } | exp_prag(exp) { $1 } -- See Note [Pragmas and operator fixity] infixexp :: { ECP } @@ -2510,11 +2617,13 @@ exp_prag(e) :: { ECP } (fst $ unLoc $1) } exp10 :: { ECP } - : '-' fexp { ECP $ + -- See Note [%shift: exp10 -> '-' fexp] + : '-' fexp %shift { ECP $ unECP $2 >>= \ $2 -> amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] } - | fexp { $1 } + -- See Note [%shift: exp10 -> fexp] + | fexp %shift { $1 } optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } @@ -2690,7 +2799,8 @@ aexp1 :: { ECP } aexp2 :: { ECP } : qvar { ECP $ mkHsVarPV $! $1 } | qcon { ECP $ mkHsVarPV $! $1 } - | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) } + -- See Note [%shift: aexp2 -> ipvar] + | ipvar %shift { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) } | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExtField Nothing $! unLoc $1) } | literal { ECP $ mkHsLitPV $! $1 } -- This will enable overloaded strings permanently. Normally the renamer turns HsString @@ -2732,7 +2842,8 @@ aexp2 :: { ECP } | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } - | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) } + -- See Note [%shift: aexp2 -> TH_TY_QUOTE] + | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (ExpBr noExtField $2)) @@ -2874,7 +2985,8 @@ tup_tail :: { forall b. DisambECP b => PV [Located (Maybe (Located b))] } return ((L (gl $1) (Just $1)) : snd $2) } | texp { unECP $1 >>= \ $1 -> return [L (gl $1) (Just $1)] } - | {- empty -} { return [noLoc Nothing] } + -- See Note [%shift: tup_tail -> {- empty -}] + | {- empty -} %shift { return [noLoc Nothing] } ----------------------------------------------------------------------------- -- List expressions @@ -3385,7 +3497,8 @@ child. -} qtyconop :: { Located RdrName } -- Qualified or unqualified - : qtyconsym { $1 } + -- See Note [%shift: qtyconop -> qtyconsym] + : qtyconsym %shift { $1 } | '`' qtycon '`' {% ams (sLL $1 $> (unLoc $2)) [mj AnnBackquote $1,mj AnnVal $2 ,mj AnnBackquote $3] } @@ -3552,7 +3665,8 @@ special_id | 'capi' { sL1 $1 (fsLit "capi") } | 'prim' { sL1 $1 (fsLit "prim") } | 'javascript' { sL1 $1 (fsLit "javascript") } - | 'group' { sL1 $1 (fsLit "group") } + -- See Note [%shift: special_id -> 'group'] + | 'group' %shift { sL1 $1 (fsLit "group") } | 'stock' { sL1 $1 (fsLit "stock") } | 'anyclass' { sL1 $1 (fsLit "anyclass") } | 'via' { sL1 $1 (fsLit "via") } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87e2e2b17afed82d30841d5b44c977123b93ecc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87e2e2b17afed82d30841d5b44c977123b93ecc4 You're receiving 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 21 00:31:06 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 20 Sep 2020 20:31:06 -0400 Subject: [Git][ghc/ghc][master] 8 commits: testsuite: Unmark T12971 as broken on Windows Message-ID: <5f67f44a24c74_80b1062e1b0133620f4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 11 changed files: - libraries/base/tests/Concurrent/ThreadDelay001.hs - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/driver/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/rts/T12771/all.T - testsuite/tests/rts/T13082/all.T - testsuite/tests/rts/T14611/all.T - testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 - testsuite/tests/th/all.T Changes: ===================================== libraries/base/tests/Concurrent/ThreadDelay001.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} -- Test that threadDelay actually sleeps for (at least) as long as we -- ask it ===================================== libraries/base/tests/all.T ===================================== @@ -17,7 +17,10 @@ test('readFloat', exit_code(1), compile_and_run, ['']) test('enumDouble', normal, compile_and_run, ['']) test('enumRatio', normal, compile_and_run, ['']) test('enumNumeric', normal, compile_and_run, ['']) -test('tempfiles', normal, compile_and_run, ['']) +# N.B. the tempfile format is slightly different than this test expects on +# Windows *except* if using WinIO. The `when` clause below can be removed +# after WinIO becomes the default. +test('tempfiles', when(opsys('mingw32'), only_ways(['winio'])), compile_and_run, ['']) test('fixed', normal, compile_and_run, ['']) test('quotOverflow', normal, compile_and_run, ['']) test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts']) ===================================== testsuite/driver/testlib.py ===================================== @@ -751,22 +751,24 @@ def normalise_win32_io_errors(name, opts): slightly in the error messages that they provide. Normalise these differences away, preferring the new WinIO errors. - This can be dropped when the old IO manager is removed. + This normalization can be dropped when the old IO manager is removed. """ SUBS = [ - ('Bad file descriptor', 'The handle is invalid'), + ('Bad file descriptor', 'The handle is invalid.'), ('Permission denied', 'Access is denied.'), ('No such file or directory', 'The system cannot find the file specified.'), ] - def f(s: str): + def normalizer(s: str) -> str: for old,new in SUBS: s = s.replace(old, new) return s - return when(opsys('mingw32'), normalise_fun(f)) + if opsys('mingw32'): + _normalise_fun(name, opts, normalizer) + _normalise_errmsg_fun(name, opts, normalizer) def normalise_version_( *pkgs ): def normalise_version__( str ): ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) +test('T12971', ignore_stdout, makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -30,10 +30,12 @@ test('T10458', ghci_script, ['T10458.script']) test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_msvc']) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -142,10 +142,10 @@ test('T5979', normalise_version("transformers")], ghci_script, ['T5979.script']) test('T5975a', - [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + 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'), when(opsys('mingw32'), expect_broken(7305))], + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) ===================================== testsuite/tests/rts/T12771/all.T ===================================== @@ -1,4 +1,5 @@ test('T12771', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T12771']) ===================================== testsuite/tests/rts/T13082/all.T ===================================== @@ -16,6 +16,7 @@ def normalise_search_dirs (str): #-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T13082_good']) ===================================== testsuite/tests/rts/T14611/all.T ===================================== @@ -1,4 +1,5 @@ test('T14611', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T14611']) ===================================== testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 ===================================== @@ -1 +1 @@ -outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. +outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. ===================================== testsuite/tests/th/all.T ===================================== @@ -51,7 +51,8 @@ test('TH_NestedSplices', [], multimod_compile, # normal way first, which is why the work is done by a Makefile rule. test('TH_spliceE5_prof', [req_profiling, only_ways(['normal']), - when(ghc_dynamic(), expect_broken(11495))], + when(ghc_dynamic(), expect_broken(11495)), + when(opsys('mingw32'), expect_broken(18271))], makefile_test, ['TH_spliceE5_prof']) test('TH_spliceE5_prof_ext', [req_profiling, only_ways(['normal'])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87e2e2b17afed82d30841d5b44c977123b93ecc4...9df77fed8918bb335874a584a829ee32325cefb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87e2e2b17afed82d30841d5b44c977123b93ecc4...9df77fed8918bb335874a584a829ee32325cefb5 You're receiving 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 21 00:45:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 20 Sep 2020 20:45:18 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/az/ghc-9.0-anns-2 Message-ID: <5f67f79ec0a41_80b8cd4da01336459e@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/az/ghc-9.0-anns-2 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 21 00:45:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 20 Sep 2020 20:45:19 -0400 Subject: [Git][ghc/ghc][ghc-9.0] API Annotations: Fix annotation for strictness Message-ID: <5f67f79f9eea1_80b8cd4da0133647c5@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: f91ea170 by Alan Zimmerman at 2020-09-20T19:25:22+01:00 API Annotations: Fix annotation for strictness This adds the correct location for a ! or ~. It is a reconstruction of 3ccc80ee6120db7ead579c6e9fc5c2164f3bf575, some of which got mangled in the backport process. - - - - - 1 changed file: - compiler/GHC/Parser/PostProcess.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1374,19 +1374,24 @@ pBangTy lt@(L l1 _) xs = Nothing -> (False, lt, pure (), xs) Just (l2, anns, prag, unpk, xs') -> let bl = combineSrcSpans l1 l2 - bt = addUnpackedness (prag, unpk) lt - in (True, L bl bt, addAnnsAt bl anns, xs') + (anns2, bt) = addUnpackedness (prag, unpk) lt + in (True, L bl bt, addAnnsAt bl (anns ++ anns2), xs') mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs mkBangTy strictness = HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness) -addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs -addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t)) +addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> ([AddAnn], HsType GhcPs) +addUnpackedness (prag, unpk) (L l (HsBangTy x bang t)) | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang - = HsBangTy x (HsSrcBang prag unpk strictness) t + = let + anns = case strictness of + SrcLazy -> [AddAnn AnnTilde (srcSpanFirstCharacter l)] + SrcStrict -> [AddAnn AnnBang (srcSpanFirstCharacter l)] + NoSrcStrict -> [] + in (anns, HsBangTy x (HsSrcBang prag unpk strictness) t) addUnpackedness (prag, unpk) t - = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t + = ([], HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t) -- | Merge a /reversed/ and /non-empty/ soup of operators and operands -- into a type. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f91ea170d86fab45a9f4658b8b02f4adede9aef7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f91ea170d86fab45a9f4658b8b02f4adede9aef7 You're receiving 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 21 09:11:39 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Mon, 21 Sep 2020 05:11:39 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] 2 commits: Return [FamInst] rather than representation tycons from tcInstDecls1 Message-ID: <5f686e4bb3f58_80b3f8429283f741339237a@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: f27a94c7 by Adam Gundry at 2020-09-21T09:30:23+01:00 Return [FamInst] rather than representation tycons from tcInstDecls1 - - - - - bca7c799 by Adam Gundry at 2020-09-21T10:10:59+01:00 Refactor: move addClsInsts and addFamInsts out of tcInstDecls1 Also modify addTyConsToGblEnv to use the thing_inside pattern - - - - - 6 changed files: - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Instance.hs-boot - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/Instantiate.hs Changes: ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -238,8 +238,7 @@ tcDeriving deriv_infos deriv_decls FormatHaskell (ddump_deriving inst_info rn_binds famInsts)) - ; gbl_env <- tcExtendLocalInstEnv (map iSpec (bagToList inst_info)) - getGblEnv + ; gbl_env <- addClsInsts (bagToList inst_info) getGblEnv ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ concat fvs) ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } } where ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Tc.TyCl.Utils import GHC.Tc.TyCl.Class import {-# SOURCE #-} GHC.Tc.TyCl.Instance( tcInstDecls1 ) import GHC.Tc.Deriv (DerivInfo(..)) +import GHC.Tc.Utils.Instantiate ( addClsInsts ) import GHC.Tc.Utils.Unify ( checkTvConstraints ) import GHC.Tc.Gen.HsType import GHC.Tc.Instance.Class( AssocInstInfo(..) ) @@ -195,19 +196,20 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds -- Step 3: Add the implicit things; -- we want them in the environment because -- they may be mentioned in interface files - ; gbl_env <- addTyConsToGblEnv tyclss + ; addTyConsToGblEnv tyclss $ do { -- Step 4: check instance declarations - ; (gbl_env', inst_info, datafam_deriv_info, data_rep_tycons) <- - setGblEnv gbl_env $ - tcInstDecls1 instds + ; (inst_info, fam_insts, datafam_deriv_info) <- tcInstDecls1 instds + ; addClsInsts inst_info $ + addFamInsts fam_insts $ do { -- Step 5: build record selectors/updaters, don't type-check them yet -- See Note [Calling tcRecSelBinds] in GHC.Tc.TyCl.Utils - ; rec_sel_upd_binds <- mkRecSelBinds (tyclss ++ data_rep_tycons) + ; rec_sel_upd_binds <- mkRecSelBinds (tyclss ++ famInstsRepTyCons fam_insts) + ; gbl_env' <- getGblEnv ; let deriv_info = datafam_deriv_info ++ data_deriv_info - ; return (gbl_env', inst_info, deriv_info, rec_sel_upd_binds) } + ; return (gbl_env', inst_info, deriv_info, rec_sel_upd_binds) }}} -- Gives the kind for every TyCon that has a standalone kind signature type KindSigEnv = NameEnv Kind ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Prelude import GHC.Hs import GHC.Tc.Gen.Bind import GHC.Tc.TyCl -import GHC.Tc.TyCl.Utils ( addTyConsToGblEnv ) import GHC.Tc.TyCl.Class ( tcClassDecl2, tcATDefault, HsSigFun, mkHsSigFun, badMethodErr, findMethodBind, instantiateMethod ) @@ -379,28 +378,18 @@ Gather up the instance declarations from their various sources tcInstDecls1 -- Deal with both source-code and imported instance decls :: [LInstDecl GhcRn] -- Source code instance decls - -> TcM (TcGblEnv, -- The full inst env - [InstInfo GhcRn], -- Source-code instance decls to process; + -> TcM ([InstInfo GhcRn], -- Source-code instance decls to process; -- contains all dfuns for this module - [DerivInfo], -- From data family instances - [TyCon]) -- Data family instance representation tycons + [FamInst], -- Family instances + [DerivInfo]) -- From data family instances tcInstDecls1 inst_decls = do { -- Do class and family instance declarations ; stuff <- mapAndRecoverM tcLocalInstDecl inst_decls - - ; let (local_infos_s, fam_insts_s, datafam_deriv_infos) = unzip3 stuff - fam_insts = concat fam_insts_s - local_infos = concat local_infos_s - - ; (data_rep_tycons, gbl_env) <- addClsInsts local_infos $ - addFamInsts fam_insts $ - getGblEnv - - ; return ( gbl_env - , local_infos - , concat datafam_deriv_infos - , data_rep_tycons ) } + ; let (local_infos_s, fam_insts_s, datafam_deriv_infos_s) = unzip3 stuff + ; return ( concat local_infos_s + , concat fam_insts_s + , concat datafam_deriv_infos_s ) } -- | Use DerivInfo for data family instances (produced by tcInstDecls1), -- datatype declarations (TyClDecl), and standalone deriving declarations @@ -417,28 +406,6 @@ tcInstDeclsDeriv deriv_infos derivds else do { (tcg_env, info_bag, valbinds) <- tcDeriving deriv_infos derivds ; return (tcg_env, bagToList info_bag, valbinds) } -addClsInsts :: [InstInfo GhcRn] -> TcM a -> TcM a -addClsInsts infos thing_inside - = tcExtendLocalInstEnv (map iSpec infos) thing_inside - -addFamInsts :: [FamInst] -> TcM a -> TcM ([TyCon], a) --- Extend (a) the family instance envt --- (b) the type envt with stuff from data type decls --- Additionally return the data family representation tycons -addFamInsts fam_insts thing_inside - = tcExtendLocalFamInstEnv fam_insts $ - tcExtendGlobalEnv axioms $ - do { traceTc "addFamInsts" (pprFamInsts fam_insts) - ; gbl_env <- addTyConsToGblEnv data_rep_tycons - -- Does not add its axiom; that comes - -- from adding the 'axioms' above - ; x <- setGblEnv gbl_env thing_inside - ; return (data_rep_tycons, x) } - where - axioms = map (ACoAxiom . toBranchedAxiom . famInstAxiom) fam_insts - data_rep_tycons = famInstsRepTyCons fam_insts - -- The representation tycons for 'data instances' declarations - {- Note [Deriving inside TH brackets] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/TyCl/Instance.hs-boot ===================================== @@ -5,7 +5,7 @@ module GHC.Tc.TyCl.Instance ( tcInstDecls1 ) where -import GHC.Core.TyCon +import GHC.Core.FamInstEnv( FamInst ) import GHC.Hs import GHC.Tc.Types import GHC.Tc.Utils.Env( InstInfo ) @@ -14,4 +14,4 @@ import GHC.Tc.Deriv -- We need this because of the mutual recursion -- between GHC.Tc.TyCl and GHC.Tc.TyCl.Instance tcInstDecls1 :: [LInstDecl GhcRn] - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], [TyCon]) + -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo]) ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Tc.TyCl.Utils( checkClassCycles, -- * Implicits - addTyConsToGblEnv, mkDefaultMethodType, + addFamInsts, addTyConsToGblEnv, mkDefaultMethodType, -- * Record selectors tcRecSelBinds, mkRecSelBinds, mkOneRecordSelector @@ -32,6 +32,7 @@ module GHC.Tc.TyCl.Utils( import GHC.Prelude +import GHC.Tc.Instance.Family import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env import GHC.Tc.Gen.Bind( tcValBinds ) @@ -43,6 +44,7 @@ import GHC.Builtin.Types( unitTy, mkBoxedTupleTy ) import GHC.Core.Make( rEC_SEL_ERROR_ID ) import GHC.Hs import GHC.Core.Class +import GHC.Core.FamInstEnv import GHC.Core.Type import GHC.Driver.Types import GHC.Core.TyCon @@ -58,6 +60,7 @@ import GHC.Types.Id.Info import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Core.Coercion ( ltRole ) +import GHC.Core.Coercion.Axiom ( toBranchedAxiom ) import GHC.Types.Basic import GHC.Types.SrcLoc import GHC.Types.Unique ( mkBuiltinUnique ) @@ -750,20 +753,36 @@ updateRoleEnv name n role * * ********************************************************************* -} -addTyConsToGblEnv :: [TyCon] -> TcM TcGblEnv +addFamInsts :: [FamInst] -> TcM a -> TcM a +-- Extend (a) the family instance envt +-- (b) the type envt with stuff from data type decls +addFamInsts fam_insts thing_inside + = tcExtendLocalFamInstEnv fam_insts $ + tcExtendGlobalEnv axioms $ + do { traceTc "addFamInsts" (pprFamInsts fam_insts) + ; addTyConsToGblEnv data_rep_tycons thing_inside + -- Does not add its axiom; that comes + -- from adding the 'axioms' above + } + where + axioms = map (ACoAxiom . toBranchedAxiom . famInstAxiom) fam_insts + data_rep_tycons = famInstsRepTyCons fam_insts + -- The representation tycons for 'data instances' declarations + +addTyConsToGblEnv :: [TyCon] -> TcM a -> TcM a -- Given a [TyCon], add to the TcGblEnv -- * extend the TypeEnv with the tycons -- * extend the TypeEnv with their implicitTyThings -- * extend the TypeEnv with any default method Ids -- * add bindings for record selectors -addTyConsToGblEnv tyclss +addTyConsToGblEnv tyclss thing_inside = tcExtendTyConEnv tyclss $ tcExtendGlobalEnvImplicit implicit_things $ tcExtendGlobalValEnv def_meth_ids $ do { traceTc "tcAddTyCons" $ vcat [ text "tycons" <+> ppr tyclss , text "implicits" <+> ppr implicit_things ] - ; getGblEnv } + ; thing_inside } where implicit_things = concatMap implicitTyConThings tyclss def_meth_ids = mkDefaultMethodIds tyclss ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -28,7 +28,7 @@ module GHC.Tc.Utils.Instantiate ( newClsInst, tcGetInsts, tcGetInstEnvs, getOverlapFlag, - tcExtendLocalInstEnv, + addClsInsts, instCallConstraints, newMethodFromName, tcSyntaxName, @@ -846,6 +846,10 @@ instOrphWarn inst text "wrap the type with a newtype and declare the instance on the new type." : [] +addClsInsts :: [InstInfo GhcRn] -> TcM a -> TcM a +addClsInsts infos thing_inside + = tcExtendLocalInstEnv (map iSpec infos) thing_inside + tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a -- Add new locally-defined instances tcExtendLocalInstEnv dfuns thing_inside View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a943914b0cc0c9a399bd575651a2ba4ab9375ae8...bca7c7995cc382c82d5286353470398bfb6b2200 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a943914b0cc0c9a399bd575651a2ba4ab9375ae8...bca7c7995cc382c82d5286353470398bfb6b2200 You're receiving 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 21 10:06:46 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 06:06:46 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f687b363d644_80b10c1ef0c13398338@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: aaef1485 by Sebastian Graf at 2020-09-21T12:03:38+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 14 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + compiler/GHC/Types/Unique/FuelTank.hs - compiler/ghc.cabal.in - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -161,6 +161,7 @@ import GHC.Types.Basic import GHC.Types.ForeignCall import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Unique.FuelTank import GHC.Core.Coercion.Axiom import GHC.Builtin.Names import GHC.Data.Maybe @@ -2747,13 +2748,11 @@ good to be able to unwrap multiple layers. The function that manages all this is checkRecTc. -} -data RecTcChecker = RC !Int (NameEnv Int) - -- The upper bound, and the number of times - -- we have encountered each TyCon +newtype RecTcChecker = RC (FuelTank TyCon) -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'. initRecTc :: RecTcChecker -initRecTc = RC defaultRecTcMaxBound emptyNameEnv +initRecTc = RC (initFuelTank defaultRecTcMaxBound) -- | The default upper bound (100) for the number of times a 'RecTcChecker' is -- allowed to encounter each 'TyCon'. @@ -2764,18 +2763,14 @@ defaultRecTcMaxBound = 100 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed -- to encounter each 'TyCon'. setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker -setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts +setRecTcMaxBound new_bound (RC tank) = RC (setFuel new_bound tank) checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker -- Nothing => Recursion detected -- Just rec_tcs => Keep going -checkRecTc (RC bound rec_nts) tc - = case lookupNameEnv rec_nts tc_name of - Just n | n >= bound -> Nothing - | otherwise -> Just (RC bound (extendNameEnv rec_nts tc_name (n+1))) - Nothing -> Just (RC bound (extendNameEnv rec_nts tc_name 1)) - where - tc_name = tyConName tc +checkRecTc (RC tank) tc = case burnFuel tank tc of + OutOfFuel -> Nothing + FuelLeft tank' -> Just (RC tank') -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitingPatterns 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitingPatterns vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Types/Unique/FuelTank.hs ===================================== @@ -0,0 +1,41 @@ +-- | Model fuel consumption to detect recursive use of a 'Uniqable' thing. +module GHC.Types.Unique.FuelTank + ( FuelTank, initFuelTank, setFuel, burnFuel, FuelBurntResult(..) + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.FM +import GHC.Utils.Outputable + +data FuelTank uniq + = FT + { init_fuel :: !Int -- ^ The upper bound of encounters + , encounters :: !(UniqFM uniq Int) -- ^ Number of times we have seen a 'u' + } + +-- | Initialise a 'FuelTank' with the given amount of /fuel/, an upper bound +-- for how often a given uniquable thing may be encountered. +initFuelTank :: Int -> FuelTank uniq +initFuelTank fuel = FT { init_fuel = fuel, encounters = emptyUFM } + +-- | Change the upper bound for the number of times a 'FuelTank' is allowed +-- to encounter each 'TyCon'. +setFuel :: Int -> FuelTank uniq -> FuelTank uniq +setFuel new_fuel tank = tank { init_fuel = new_fuel } + +data FuelBurntResult uniq + = OutOfFuel + | FuelLeft !(FuelTank uniq) + +-- | Burns one fuel in the 'FuelTank' for the given uniq thing. Returns +-- 'OutOfFuel' when all fuel was burned and @'FuelLeft' tank@ when there's +-- still fuel left in the new @tank at . +burnFuel :: Uniquable uniq => FuelTank uniq -> uniq -> FuelBurntResult uniq +burnFuel (FT init_fuel encounters) u = case lookupUFM encounters u of + Just fuel_used | fuel_used >= init_fuel -> OutOfFuel + _ -> FuelLeft (FT init_fuel (addToUFM_C (+) encounters u 1)) + +instance Outputable (FuelTank u) where + ppr (FT init_fuel encounters) = ppr (init_fuel, encounters) ===================================== compiler/ghc.cabal.in ===================================== @@ -565,6 +565,7 @@ Library GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM + GHC.Types.Unique.FuelTank GHC.Types.Unique.Set GHC.Utils.Misc GHC.Cmm.Dataflow ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaef148559b8e0b51f55a964aca678666879f9f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaef148559b8e0b51f55a964aca678666879f9f2 You're receiving 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 21 10:18:30 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 06:18:30 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f687df6a4928_80b3f84942385cc1339872e@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 5ccf47bb by Sebastian Graf at 2020-09-21T12:16:32+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 11 changed files: - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,11 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitingPatterns 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitingPatterns vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,10 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +-- TODO: Bump to 900 +#if __GLASGOW_HASKELL__ <= 810 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ccf47bb2a4191579ad633837a3dcd3ca1d1c5da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ccf47bb2a4191579ad633837a3dcd3ca1d1c5da You're receiving 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 21 10:29:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 06:29:29 -0400 Subject: [Git][ghc/ghc][wip/T18249] 24 commits: docs: correct haddock reference Message-ID: <5f688089cdd4d_80b3f8458a944641339919f@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - c79f1477 by Sebastian Graf at 2020-09-21T12:27:40+02:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - c18b6f3d by Sebastian Graf at 2020-09-21T12:27:40+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 30 changed files: - README.md - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ccf47bb2a4191579ad633837a3dcd3ca1d1c5da...c18b6f3d181c390f3f86f066f07d150ea31b9152 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ccf47bb2a4191579ad633837a3dcd3ca1d1c5da...c18b6f3d181c390f3f86f066f07d150ea31b9152 You're receiving 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 21 10:30:17 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 06:30:17 -0400 Subject: [Git][ghc/ghc][wip/T18249] PmCheck: Rewrite inhabitation test Message-ID: <5f6880b91d6c6_80bae0151413399576@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18249 at Glasgow Haskell Compiler / GHC Commits: 3a08f97b by Sebastian Graf at 2020-09-21T12:30:08+02:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 11 changed files: - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,10 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +#if __GLASGOW_HASKELL__ <= 900 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitingPatterns 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do !div <- if isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitingPatterns vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,9 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +#if __GLASGOW_HASKELL__ <= 900 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a08f97bd270bf67ef92a334bd65794ccfbf06ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a08f97bd270bf67ef92a334bd65794ccfbf06ad You're receiving 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 21 12:49:27 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 21 Sep 2020 08:49:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18723 Message-ID: <5f68a1574d5b6_80b3f8479bd56a413416065@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18723 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18723 You're receiving 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 21 12:58:29 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 08:58:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18626 Message-ID: <5f68a375e872e_80b1115e01c134187f0@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18626 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18626 You're receiving 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 21 12:59:24 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 08:59:24 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f68a3ac54aa8_80b110e0130134203cd@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: cb3ced5d by Sebastian Graf at 2020-09-21T14:59:12+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. There's a regression test in `T18626`. Fixes #18626. - - - - - 3 changed files: - compiler/GHC/HsToCore/PmCheck.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -142,7 +142,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -322,7 +322,11 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of local binds for long-distance +-- information and the actual list of 'GRHS'. +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -363,6 +367,10 @@ instance Outputable (PmMatch Pre) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = pprLygGuards grds <+> ppr grhss +instance Outputable (PmGRHSs Pre) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Pre) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs @@ -388,6 +396,10 @@ instance Outputable (PmMatch Post) where ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = pprRedSets red <+> ppr grhss +instance Outputable (PmGRHSs Post) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Post) where ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = pprRedSets red <+> text "->" <+> pprSrcInfo rhs @@ -699,12 +711,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -724,7 +738,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM GrdVec desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -733,8 +747,19 @@ desugarGuard guard = case guard of ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" -- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec -desugarLet _binds = return [] +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM GrdVec +desugarLocalBinds (L _ (HsValBinds _ (ValBinds _ binds _))) = concatMapM go (bagToList binds) + where + -- We are only interested in FunBinds with single match groups without any + -- patterns. + go :: Located (HsBindLR GhcTc GhcTc) -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -1019,8 +1044,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = @@ -1085,7 +1111,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -1161,8 +1190,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -142,6 +142,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('T18626', 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, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb3ced5d24d13d4e0036243113ad359c1241911e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb3ced5d24d13d4e0036243113ad359c1241911e You're receiving 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 21 13:17:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 09:17:23 -0400 Subject: [Git][ghc/ghc][wip/T18223] 47 commits: Fix rtsopts documentation Message-ID: <5f68a7e3c1b85_80b3f8443f39d44134248f3@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18223 at Glasgow Haskell Compiler / GHC Commits: 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - d360aa35 by Simon Peyton Jones at 2020-09-21T09:17:09-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 30 changed files: - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56ac867d3950ef22649b1970815fa8cf99f89402...d360aa35bf3e23539b96f24f65197a4c17a343d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56ac867d3950ef22649b1970815fa8cf99f89402...d360aa35bf3e23539b96f24f65197a4c17a343d4 You're receiving 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 21 13:18:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 09:18:44 -0400 Subject: [Git][ghc/ghc][wip/T18603] 47 commits: Fix rtsopts documentation Message-ID: <5f68a83486901_80b3f84105045f01342690@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18603 at Glasgow Haskell Compiler / GHC Commits: 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 8475c975 by Simon Peyton Jones at 2020-09-21T09:18:29-04: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: - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/704504d1b2c78b7214d5e8b6af27a4bdf39dae8f...8475c975cf769f04cc596f7308b660cbeb6e8375 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/704504d1b2c78b7214d5e8b6af27a4bdf39dae8f...8475c975cf769f04cc596f7308b660cbeb6e8375 You're receiving 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 21 13:24:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 09:24:10 -0400 Subject: [Git][ghc/ghc][wip/andreask/exprSizeBangs] 146 commits: SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' Message-ID: <5f68a97af1c1e_80b3f84105045f0134292e4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/andreask/exprSizeBangs 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. - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 913c91c3 by Andreas Klebinger at 2020-09-21T09:23:59-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - 29 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - README.md - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.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/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.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/Node.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - 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/8dbaa68a2d1944199ba206eaa77fd43fdea69f55...913c91c37daf16c4b2491dc3bfaf217e9c05006a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8dbaa68a2d1944199ba206eaa77fd43fdea69f55...913c91c37daf16c4b2491dc3bfaf217e9c05006a You're receiving 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 21 14:20:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 10:20:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f68b69e8324c_80b3f8459792238134429e9@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 Mon Sep 21 14:35:51 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 21 Sep 2020 10:35:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: testsuite: Unmark T12971 as broken on Windows Message-ID: <5f68ba4726a7_80b8df649013454395@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - f727ef24 by Ryan Scott at 2020-09-21T10:35:39-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 8a9e908e by Ryan Scott at 2020-09-21T10:35:39-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - 629a10f1 by Ben Gamari at 2020-09-21T10:35:39-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 18 changed files: - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - hadrian/stack.yaml - libraries/base/tests/Concurrent/ThreadDelay001.hs - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/driver/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/rts/T12771/all.T - testsuite/tests/rts/T13082/all.T - testsuite/tests/rts/T14611/all.T - testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_fail/T18714.hs - + testsuite/tests/typecheck/should_fail/T18714.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2838,7 +2838,6 @@ expectedKindInCtxt :: UserTypeCtxt -> ContextKind -- Depending on the context, we might accept any kind (for instance, in a TH -- splice), or only certain kinds (like in type signatures). expectedKindInCtxt (TySynCtxt _) = AnyKind -expectedKindInCtxt ThBrackCtxt = AnyKind expectedKindInCtxt (GhciCtxt {}) = AnyKind -- The types in a 'default' decl can have varying kinds -- See Note [Extended defaults]" in GHC.Tc.Utils.Env ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -84,15 +84,12 @@ data UserTypeCtxt -- or (x::t, y) = e | RuleSigCtxt Name -- LHS of a RULE forall -- RULE "foo" forall (x :: a -> a). f (Just x) = ... - | ResSigCtxt -- Result type sig - -- f x :: t = .... | ForSigCtxt Name -- Foreign import or export signature | DefaultDeclCtxt -- Types in a default declaration | InstDeclCtxt Bool -- An instance declaration -- True: stand-alone deriving -- False: vanilla instance declaration | SpecInstCtxt -- SPECIALISE instance pragma - | ThBrackCtxt -- Template Haskell type brackets [t| ... |] | GenSigCtxt -- Higher-rank or impredicative situations -- e.g. (f e) where f has a higher-rank type -- We might want to elaborate this @@ -136,9 +133,7 @@ pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature fo pprUserTypeCtxt TypeAppCtxt = text "a type argument" pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c) -pprUserTypeCtxt ThBrackCtxt = text "a Template Haskell quotation [t|...|]" pprUserTypeCtxt PatSigCtxt = text "a pattern type signature" -pprUserTypeCtxt ResSigCtxt = text "a result type signature" pprUserTypeCtxt (ForSigCtxt n) = text "the foreign declaration for" <+> quotes (ppr n) pprUserTypeCtxt DefaultDeclCtxt = text "a type in a `default' declaration" pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration" ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -348,7 +348,6 @@ checkValidType ctxt ty rank = case ctxt of DefaultDeclCtxt-> MustBeMonoType - ResSigCtxt -> MustBeMonoType PatSigCtxt -> rank0 RuleSigCtxt _ -> rank1 TySynCtxt _ -> rank0 @@ -372,7 +371,6 @@ checkValidType ctxt ty ForSigCtxt _ -> rank1 SpecInstCtxt -> rank1 - ThBrackCtxt -> rank1 GhciCtxt {} -> ArbitraryRank TyVarBndrKindCtxt _ -> rank0 @@ -472,18 +470,81 @@ forAllAllowed ArbitraryRank = True forAllAllowed (LimitedRank forall_ok _) = forall_ok forAllAllowed _ = False +-- | Indicates whether a 'UserTypeCtxt' represents type-level contexts, +-- kind-level contexts, or both. +data TypeOrKindCtxt + = OnlyTypeCtxt + -- ^ A 'UserTypeCtxt' that only represents type-level positions. + | OnlyKindCtxt + -- ^ A 'UserTypeCtxt' that only represents kind-level positions. + | BothTypeAndKindCtxt + -- ^ A 'UserTypeCtxt' that can represent both type- and kind-level positions. + deriving Eq + +instance Outputable TypeOrKindCtxt where + ppr ctxt = text $ case ctxt of + OnlyTypeCtxt -> "OnlyTypeCtxt" + OnlyKindCtxt -> "OnlyKindCtxt" + BothTypeAndKindCtxt -> "BothTypeAndKindCtxt" + +-- | Determine whether a 'UserTypeCtxt' can represent type-level contexts, +-- kind-level contexts, or both. +typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt +typeOrKindCtxt (FunSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InfSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ExprSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (TypeAppCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSynCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (RuleSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ForSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DefaultDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InstDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SpecInstCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (GenSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ClassSCCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SigmaCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DataTyCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DerivClauseCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ConArgCtxt {}) = OnlyTypeCtxt + -- Although data constructors can be promoted with DataKinds, we always + -- validity-check them as though they are the types of terms. We may need + -- to revisit this decision if we ever allow visible dependent quantification + -- in the types of data constructors. + +typeOrKindCtxt (KindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (StandaloneKindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyVarBndrKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (DataKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TySynKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyFamResKindCtxt {}) = OnlyKindCtxt + +typeOrKindCtxt (TySynCtxt {}) = BothTypeAndKindCtxt + -- Type synonyms can have types and kinds on their RHSs +typeOrKindCtxt (GhciCtxt {}) = BothTypeAndKindCtxt + -- GHCi's :kind command accepts both types and kinds + +-- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the +-- context for a kind of a type, where the arbitrary use of constraints is +-- currently disallowed. +-- (See @Note [Constraints in kinds]@ in "GHC.Core.TyCo.Rep".) +-- If the 'UserTypeCtxt' can refer to both types and kinds, this function +-- conservatively returns 'True'. +-- +-- An example of something that is unambiguously the kind of a type is the +-- @Show a => a -> a@ in @type Foo :: Show a => a -> a at . On the other hand, the +-- same type in @foo :: Show a => a -> a@ is unambiguously the type of a term, +-- not the kind of a type, so it is permitted. allConstraintsAllowed :: UserTypeCtxt -> Bool --- We don't allow arbitrary constraints in kinds -allConstraintsAllowed (TyVarBndrKindCtxt {}) = False -allConstraintsAllowed (DataKindCtxt {}) = False -allConstraintsAllowed (TySynKindCtxt {}) = False -allConstraintsAllowed (TyFamResKindCtxt {}) = False -allConstraintsAllowed (StandaloneKindSigCtxt {}) = False -allConstraintsAllowed _ = True +allConstraintsAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> True + OnlyKindCtxt -> False + BothTypeAndKindCtxt -> True -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the -- context for the type of a term, where visible, dependent quantification is --- currently disallowed. +-- currently disallowed. If the 'UserTypeCtxt' can refer to both types and +-- kinds, this function conservatively returns 'True'. -- -- An example of something that is unambiguously the type of a term is the -- @forall a -> a -> a@ in @foo :: forall a -> a -> a at . On the other hand, the @@ -496,40 +557,10 @@ allConstraintsAllowed _ = True -- @testsuite/tests/dependent/should_fail/T16326_Fail*.hs@ (for places where -- VDQ is disallowed). vdqAllowed :: UserTypeCtxt -> Bool --- Currently allowed in the kinds of types... -vdqAllowed (KindSigCtxt {}) = True -vdqAllowed (StandaloneKindSigCtxt {}) = True -vdqAllowed (TySynCtxt {}) = True -vdqAllowed (ThBrackCtxt {}) = True -vdqAllowed (GhciCtxt {}) = True -vdqAllowed (TyVarBndrKindCtxt {}) = True -vdqAllowed (DataKindCtxt {}) = True -vdqAllowed (TySynKindCtxt {}) = True -vdqAllowed (TyFamResKindCtxt {}) = True --- ...but not in the types of terms. -vdqAllowed (ConArgCtxt {}) = False - -- We could envision allowing VDQ in data constructor types so long as the - -- constructor is only ever used at the type level, but for now, GHC adopts - -- the stance that VDQ is never allowed in data constructor types. -vdqAllowed (FunSigCtxt {}) = False -vdqAllowed (InfSigCtxt {}) = False -vdqAllowed (ExprSigCtxt {}) = False -vdqAllowed (TypeAppCtxt {}) = False -vdqAllowed (PatSynCtxt {}) = False -vdqAllowed (PatSigCtxt {}) = False -vdqAllowed (RuleSigCtxt {}) = False -vdqAllowed (ResSigCtxt {}) = False -vdqAllowed (ForSigCtxt {}) = False -vdqAllowed (DefaultDeclCtxt {}) = False --- We count class constraints as "types of terms". All of the cases below deal --- with class constraints. -vdqAllowed (InstDeclCtxt {}) = False -vdqAllowed (SpecInstCtxt {}) = False -vdqAllowed (GenSigCtxt {}) = False -vdqAllowed (ClassSCCtxt {}) = False -vdqAllowed (SigmaCtxt {}) = False -vdqAllowed (DataTyCtxt {}) = False -vdqAllowed (DerivClauseCtxt {}) = False +vdqAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> False + OnlyKindCtxt -> True + BothTypeAndKindCtxt -> True {- Note [Correctness and performance of type synonym validity checking] @@ -1329,11 +1360,9 @@ okIPCtxt (InfSigCtxt {}) = True okIPCtxt ExprSigCtxt = True okIPCtxt TypeAppCtxt = True okIPCtxt PatSigCtxt = True -okIPCtxt ResSigCtxt = True okIPCtxt GenSigCtxt = True okIPCtxt (ConArgCtxt {}) = True okIPCtxt (ForSigCtxt {}) = True -- ?? -okIPCtxt ThBrackCtxt = True okIPCtxt (GhciCtxt {}) = True okIPCtxt SigmaCtxt = True okIPCtxt (DataTyCtxt {}) = True ===================================== hadrian/stack.yaml ===================================== @@ -12,3 +12,6 @@ nix: - git - ncurses - perl + +extra-deps: +- happy-1.20.0 ===================================== libraries/base/tests/Concurrent/ThreadDelay001.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} -- Test that threadDelay actually sleeps for (at least) as long as we -- ask it ===================================== libraries/base/tests/all.T ===================================== @@ -17,7 +17,10 @@ test('readFloat', exit_code(1), compile_and_run, ['']) test('enumDouble', normal, compile_and_run, ['']) test('enumRatio', normal, compile_and_run, ['']) test('enumNumeric', normal, compile_and_run, ['']) -test('tempfiles', normal, compile_and_run, ['']) +# N.B. the tempfile format is slightly different than this test expects on +# Windows *except* if using WinIO. The `when` clause below can be removed +# after WinIO becomes the default. +test('tempfiles', when(opsys('mingw32'), only_ways(['winio'])), compile_and_run, ['']) test('fixed', normal, compile_and_run, ['']) test('quotOverflow', normal, compile_and_run, ['']) test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts']) ===================================== testsuite/driver/testlib.py ===================================== @@ -751,22 +751,24 @@ def normalise_win32_io_errors(name, opts): slightly in the error messages that they provide. Normalise these differences away, preferring the new WinIO errors. - This can be dropped when the old IO manager is removed. + This normalization can be dropped when the old IO manager is removed. """ SUBS = [ - ('Bad file descriptor', 'The handle is invalid'), + ('Bad file descriptor', 'The handle is invalid.'), ('Permission denied', 'Access is denied.'), ('No such file or directory', 'The system cannot find the file specified.'), ] - def f(s: str): + def normalizer(s: str) -> str: for old,new in SUBS: s = s.replace(old, new) return s - return when(opsys('mingw32'), normalise_fun(f)) + if opsys('mingw32'): + _normalise_fun(name, opts, normalizer) + _normalise_errmsg_fun(name, opts, normalizer) def normalise_version_( *pkgs ): def normalise_version__( str ): ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) +test('T12971', ignore_stdout, makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -30,10 +30,12 @@ test('T10458', ghci_script, ['T10458.script']) test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_msvc']) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -142,10 +142,10 @@ test('T5979', normalise_version("transformers")], ghci_script, ['T5979.script']) test('T5975a', - [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + 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'), when(opsys('mingw32'), expect_broken(7305))], + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) ===================================== testsuite/tests/rts/T12771/all.T ===================================== @@ -1,4 +1,5 @@ test('T12771', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T12771']) ===================================== testsuite/tests/rts/T13082/all.T ===================================== @@ -16,6 +16,7 @@ def normalise_search_dirs (str): #-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T13082_good']) ===================================== testsuite/tests/rts/T14611/all.T ===================================== @@ -1,4 +1,5 @@ test('T14611', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T14611']) ===================================== testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 ===================================== @@ -1 +1 @@ -outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. +outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. ===================================== testsuite/tests/th/all.T ===================================== @@ -51,7 +51,8 @@ test('TH_NestedSplices', [], multimod_compile, # normal way first, which is why the work is done by a Makefile rule. test('TH_spliceE5_prof', [req_profiling, only_ways(['normal']), - when(ghc_dynamic(), expect_broken(11495))], + when(ghc_dynamic(), expect_broken(11495)), + when(opsys('mingw32'), expect_broken(18271))], makefile_test, ['TH_spliceE5_prof']) test('TH_spliceE5_prof_ext', [req_profiling, only_ways(['normal'])], ===================================== testsuite/tests/typecheck/should_fail/T18714.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +module T18714 where + +import GHC.Exts + +type Id a = a + +type F = Id (Any :: forall a. Show a => a -> a) ===================================== testsuite/tests/typecheck/should_fail/T18714.stderr ===================================== @@ -0,0 +1,7 @@ + +T18714.hs:11:14: error: + • Illegal constraint in a kind: forall a. Show a => a -> a + • In the first argument of ‘Id’, namely + ‘(Any :: forall a. Show a => a -> a)’ + In the type ‘Id (Any :: forall a. Show a => a -> a)’ + In the type declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -579,3 +579,4 @@ test('T18357a', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T18455', normal, compile_fail, ['']) test('T18534', normal, compile_fail, ['']) +test('T18714', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5aea7e6ce54caa7687af88c5dabb5caf16da874...629a10f189a5ebf06cc5d34a872f22830cb2593e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5aea7e6ce54caa7687af88c5dabb5caf16da874...629a10f189a5ebf06cc5d34a872f22830cb2593e You're receiving 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 21 14:37:00 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 21 Sep 2020 10:37:00 -0400 Subject: [Git][ghc/ghc][wip/T16762] Fixes from Simon Message-ID: <5f68ba8c14c1d_80bd33399013456586@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 60dd0659 by Simon Peyton Jones at 2020-09-21T15:35:30+01:00 Fixes from Simon 1. Comments in Hs.Type 2. Fix latent bug in emitFlatConstraints 3. Adopt Ryan's solution in tc_hs_sig_type, but with comments - - - - - 3 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -357,7 +357,7 @@ data HsForAllTelescope pass { hsf_xvis :: XHsForAllVis pass , hsf_vis_bndrs :: [LHsTyVarBndr () pass] } - | HsForAllInvis -- ^ An invisible @forall@ (e.g., @forall a {b} c -> {...}@), + | HsForAllInvis -- ^ An invisible @forall@ (e.g., @forall a {b} c. {...}@), -- where each binder has a 'Specificity'. { hsf_xinvis :: XHsForAllInvis pass , hsf_invis_bndrs :: [LHsTyVarBndr Specificity pass] @@ -416,6 +416,17 @@ emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] } -- Used to quantify the implicit binders of a type -- * Implicit binders of a type signature (LHsSigType/LHsSigWcType) -- * Patterns in a type/data family instance (HsTyPats) +-- +-- We support two forms: +-- HsOuterImplicit (implicit quantification, added by renamer) +-- f :: a -> a -- Short for f :: forall {a}. a->a +-- HsOuterExplicit (explicit user quantifiation): +-- f :: forall a. a->a +-- +-- When the user writes /visible/ quanitification +-- T :: forall k -> k -> Type +-- we use use HsOuterImplicit, wrapped around a HsForAllTy +-- for the visible quantification -- | TODO RGS: Docs data HsOuterTyVarBndrs flag pass ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -349,6 +349,7 @@ tcHsSigType ctxt sig_ty -- Spit out the implication (and perhaps fail fast) -- See Note [Failure in local type signatures] in GHC.Tc.Solver + ; traceTc "tcHsSigType 2" (ppr implic) ; emitFlatConstraints (mkImplicWC (unitBag implic)) ; ty <- zonkTcType ty @@ -358,59 +359,6 @@ tcHsSigType ctxt sig_ty where skol_info = SigTypeSkol ctxt -{- --- TODO RGS: Delete this (only for testing purposes) -tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM (Implication, TcType) --- Kind-checks/desugars an 'LHsSigType', --- solve equalities, --- and then kind-generalizes. --- This will never emit constraints, as it uses solveEqualities internally. --- No validity checking or zonking --- Returns also an implication for the unsolved constraints -tc_hs_sig_type skol_info hs_sig_type ctxt_kind - -- | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type - | L l (HsSig { sig_bndrs = outer_bndrs, sig_body = body_ty }) <- hs_sig_type - = do { let sig_vars = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_vars} -> imp_vars - HsOuterExplicit{} -> [] - hs_ty = case outer_bndrs of - HsOuterImplicit{} -> body_ty - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - L l $ HsForAllTy { hst_xforall = noExtField - , hst_tele = HsForAllInvis { hsf_xinvis = noExtField - , hsf_invis_bndrs = exp_bndrs } - , hst_body = body_ty } - ; (tc_lvl, (wanted, (spec_tkvs, ty))) - <- pushTcLevelM $ - solveLocalEqualitiesX "tc_hs_sig_type" $ - -- See Note [Failure in local type signatures] - bindImplicitTKBndrs_Skol sig_vars $ - do { kind <- newExpectedKind ctxt_kind - ; tcLHsType hs_ty kind } - -- Any remaining variables (unsolved in the solveLocalEqualities) - -- should be in the global tyvars, and therefore won't be quantified - - ; spec_tkvs <- zonkAndScopedSort spec_tkvs - ; let ty1 = mkSpecForAllTys spec_tkvs ty - - -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, - -- but constraints are so much simpler in kinds, it is much - -- easier here. (In particular, we never quantify over a - -- constraint in a type.) - ; constrained <- zonkTyCoVarsAndFV (tyCoVarsOfWC wanted) - ; let should_gen = not . (`elemVarSet` constrained) - - ; kvs <- kindGeneralizeSome should_gen ty1 - - -- Build an implication for any as-yet-unsolved kind equalities - -- See Note [Skolem escape in type signatures] - ; implic <- buildTvImplication skol_info (kvs ++ spec_tkvs) tc_lvl wanted - - ; return (implic, mkInfForAllTys kvs ty1) } --} - --- TODO RGS: This is broken. Figure out why. tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn -> ContextKind -> TcM (Implication, TcType) -- Kind-checks/desugars an 'LHsSigType', @@ -420,20 +368,49 @@ tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn -- No validity checking or zonking -- Returns also an implication for the unsolved constraints tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs - , sig_body = hs_ty })) ctxt_kind + , sig_body = hs_ty })) ctxt_kind = setSrcSpan loc $ - do { (tc_lvl, (wanted, (imp_or_exp_tkvs, ty))) - <- pushTcLevelM $ - solveLocalEqualitiesX "tc_hs_sig_type" $ + do { -- When there are /explicit/ user-written binders, e.g. + -- f :: forall a {k} (b::k). blah + -- treat it exactly like HsForAllTy; including its own, + -- individual implication constraint, so we get proper + -- telescope checking. + -- NB1: Do not be tempted to combine this implication constraint + -- with the one from kind generalisation. That messes up the + -- telescope error message, by mixing the inferred kind + -- quantifiers with the explicit ones. + -- NB2: There are no implicit binders (the forall-or-nothing rule), + -- hence implicit_bndrs = [] + -- + -- When there are only /implicit/ binders, added by the renamer, e.g. + -- f :: a -> t a -> t a + -- then bring those implicit binders into scope here. + + let body_hs_ty :: LHsType GhcRn + implicit_bndrs :: [Name] + (implicit_bndrs, body_hs_ty) + = case outer_bndrs of + HsOuterExplicit { hso_bndrs = bndrs } + -> ([], L loc $ + HsForAllTy { hst_xforall = noExtField + , hst_tele = HsForAllInvis { hsf_xinvis = noExtField + , hsf_invis_bndrs = bndrs } + , hst_body = hs_ty }) + HsOuterImplicit { hso_ximplicit = implicit_bndrs } + -> (implicit_bndrs, hs_ty) + + ; (tc_lvl, (wanted, (implicit_tkvs, ty))) + <- pushTcLevelM $ + solveLocalEqualitiesX "tc_hs_sig_type" $ -- See Note [Failure in local type signatures] - bindOuterSigTKBndrs_Skol outer_bndrs $ + bindImplicitTKBndrs_Skol implicit_bndrs $ do { kind <- newExpectedKind ctxt_kind - ; tcLHsType hs_ty kind } + ; tcLHsType body_hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- 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 mkInvisForAllTys imp_or_exp_tkvs ty + ; implicit_tkvs <- zonkAndScopedSort implicit_tkvs + ; let ty1 = mkSpecForAllTys implicit_tkvs ty -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, -- but constraints are so much simpler in kinds, it is much @@ -446,10 +423,7 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- Build an implication for any as-yet-unsolved kind equalities -- See Note [Skolem escape in type signatures] - ; implic <- buildTvImplication skol_info - (kvs ++ either id binderVars imp_or_exp_tkvs) tc_lvl wanted - -- TODO RGS: The line above can put /visible/ foralls in a tyvar implication. - -- I'm not sure if that's kosher. + ; implic <- buildTvImplication skol_info (kvs ++ implicit_tkvs) tc_lvl wanted ; return (implic, mkInfForAllTys kvs ty1) } @@ -1050,7 +1024,7 @@ tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind <- pushLevelAndCaptureConstraints $ bindExplicitTKTele_Skol_M mode tele $ -- The _M variant passes on the mode from the type, to - -- any wildards in kind signatures on the forall'd variables + -- any wildcards in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah tc_lhs_type mode ty exp_kind -- Why exp_kind? See Note [Body kind of HsForAllTy] ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -163,21 +163,28 @@ simplifyTop wanteds solveLocalEqualities :: String -> TcM a -> TcM a -- Note [Failure in local type signatures] solveLocalEqualities callsite thing_inside - = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside + = do { traceTc "solveLocalEqualities {" (vcat [ text "Called from" <+> text callsite ]) + ; (res, wanted) <- captureConstraints thing_inside ; emitFlatConstraints wanted + ; traceTc "solveLocalEqualitie }" empty ; return res } emitFlatConstraints :: WantedConstraints -> TcM () -- See Note [Failure in local type signatures] emitFlatConstraints wanted - = do { wanted <- TcM.zonkWC wanted + = do { -- Solve and zonk to esablish the + -- preconditions for floatKindEqualities + wanted <- runTcSEqualities (solveWanteds wanted) + ; wanted <- TcM.zonkWC wanted + + ; traceTc "emitFlatConstraints {" (ppr wanted) ; case floatKindEqualities wanted of - Nothing -> do { traceTc "emitFlatConstraints: failing" (ppr wanted) + Nothing -> do { traceTc "emitFlatConstraints } failing" (ppr wanted) ; emitConstraints wanted -- So they get reported! ; failM } Just (simples, holes) -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples) - ; traceTc "emitFlatConstraints:" $ + ; traceTc "emitFlatConstraints }" $ vcat [ text "simples:" <+> ppr simples , text "holes: " <+> ppr holes ] ; emitHoles holes -- Holes don't need promotion @@ -188,6 +195,11 @@ floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag Hole) -- Return Nothing if any constraints can't be floated (captured -- by skolems), or if there is an insoluble constraint, or -- IC_Telescope telescope error +-- Precondition 1: we have tried to solve the 'wanteds', both so that +-- the ic_status field is set, and because solving can make constraints +-- more floatable. +-- Precondition 2: the 'wanteds' are zonked, since floatKindEqualities +-- is not monadic floatKindEqualities wc = float_wc emptyVarSet wc where float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag Hole) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60dd0659f5d42e1a2f7620f55a1e8e3befceffe2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60dd0659f5d42e1a2f7620f55a1e8e3befceffe2 You're receiving 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 21 14:46:08 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 21 Sep 2020 10:46:08 -0400 Subject: [Git][ghc/ghc][wip/T16762] Fixes from Simon Message-ID: <5f68bcb0300f1_80b3f842737f8d0134567b6@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 9004c100 by Simon Peyton Jones at 2020-09-21T15:45:13+01:00 Fixes from Simon 1. Comments in Hs.Type 2. Fix latent bug in emitFlatConstraints 3. Adopt Ryan's solution in tc_hs_sig_type, but with comments - - - - - 4 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -357,7 +357,7 @@ data HsForAllTelescope pass { hsf_xvis :: XHsForAllVis pass , hsf_vis_bndrs :: [LHsTyVarBndr () pass] } - | HsForAllInvis -- ^ An invisible @forall@ (e.g., @forall a {b} c -> {...}@), + | HsForAllInvis -- ^ An invisible @forall@ (e.g., @forall a {b} c. {...}@), -- where each binder has a 'Specificity'. { hsf_xinvis :: XHsForAllInvis pass , hsf_invis_bndrs :: [LHsTyVarBndr Specificity pass] @@ -416,6 +416,17 @@ emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] } -- Used to quantify the implicit binders of a type -- * Implicit binders of a type signature (LHsSigType/LHsSigWcType) -- * Patterns in a type/data family instance (HsTyPats) +-- +-- We support two forms: +-- HsOuterImplicit (implicit quantification, added by renamer) +-- f :: a -> a -- Short for f :: forall {a}. a->a +-- HsOuterExplicit (explicit user quantifiation): +-- f :: forall a. a->a +-- +-- When the user writes /visible/ quanitification +-- T :: forall k -> k -> Type +-- we use use HsOuterImplicit, wrapped around a HsForAllTy +-- for the visible quantification -- | TODO RGS: Docs data HsOuterTyVarBndrs flag pass ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -349,6 +349,7 @@ tcHsSigType ctxt sig_ty -- Spit out the implication (and perhaps fail fast) -- See Note [Failure in local type signatures] in GHC.Tc.Solver + ; traceTc "tcHsSigType 2" (ppr implic) ; emitFlatConstraints (mkImplicWC (unitBag implic)) ; ty <- zonkTcType ty @@ -358,59 +359,6 @@ tcHsSigType ctxt sig_ty where skol_info = SigTypeSkol ctxt -{- --- TODO RGS: Delete this (only for testing purposes) -tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn - -> ContextKind -> TcM (Implication, TcType) --- Kind-checks/desugars an 'LHsSigType', --- solve equalities, --- and then kind-generalizes. --- This will never emit constraints, as it uses solveEqualities internally. --- No validity checking or zonking --- Returns also an implication for the unsolved constraints -tc_hs_sig_type skol_info hs_sig_type ctxt_kind - -- | HsIB { hsib_ext = sig_vars, hsib_body = hs_ty } <- hs_sig_type - | L l (HsSig { sig_bndrs = outer_bndrs, sig_body = body_ty }) <- hs_sig_type - = do { let sig_vars = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_vars} -> imp_vars - HsOuterExplicit{} -> [] - hs_ty = case outer_bndrs of - HsOuterImplicit{} -> body_ty - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - L l $ HsForAllTy { hst_xforall = noExtField - , hst_tele = HsForAllInvis { hsf_xinvis = noExtField - , hsf_invis_bndrs = exp_bndrs } - , hst_body = body_ty } - ; (tc_lvl, (wanted, (spec_tkvs, ty))) - <- pushTcLevelM $ - solveLocalEqualitiesX "tc_hs_sig_type" $ - -- See Note [Failure in local type signatures] - bindImplicitTKBndrs_Skol sig_vars $ - do { kind <- newExpectedKind ctxt_kind - ; tcLHsType hs_ty kind } - -- Any remaining variables (unsolved in the solveLocalEqualities) - -- should be in the global tyvars, and therefore won't be quantified - - ; spec_tkvs <- zonkAndScopedSort spec_tkvs - ; let ty1 = mkSpecForAllTys spec_tkvs ty - - -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, - -- but constraints are so much simpler in kinds, it is much - -- easier here. (In particular, we never quantify over a - -- constraint in a type.) - ; constrained <- zonkTyCoVarsAndFV (tyCoVarsOfWC wanted) - ; let should_gen = not . (`elemVarSet` constrained) - - ; kvs <- kindGeneralizeSome should_gen ty1 - - -- Build an implication for any as-yet-unsolved kind equalities - -- See Note [Skolem escape in type signatures] - ; implic <- buildTvImplication skol_info (kvs ++ spec_tkvs) tc_lvl wanted - - ; return (implic, mkInfForAllTys kvs ty1) } --} - --- TODO RGS: This is broken. Figure out why. tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn -> ContextKind -> TcM (Implication, TcType) -- Kind-checks/desugars an 'LHsSigType', @@ -420,20 +368,50 @@ tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn -- No validity checking or zonking -- Returns also an implication for the unsolved constraints tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs - , sig_body = hs_ty })) ctxt_kind + , sig_body = hs_ty })) ctxt_kind = setSrcSpan loc $ - do { (tc_lvl, (wanted, (imp_or_exp_tkvs, ty))) - <- pushTcLevelM $ - solveLocalEqualitiesX "tc_hs_sig_type" $ + do { -- When there are /explicit/ user-written binders, e.g. + -- f :: forall a {k} (b::k). blah + -- treat it exactly like HsForAllTy; including its own, + -- individual implication constraint, so we get proper + -- telescope checking. + -- NB1: Do not be tempted to combine this implication constraint + -- with the one from kind generalisation. That messes up the + -- telescope error message, by mixing the inferred kind + -- quantifiers with the explicit ones. See GHC.Tc.Types.Constraint + -- Note [Checking telescopes], in the "don't mix up" bullet. + -- NB2: There are no implicit binders (the forall-or-nothing rule), + -- hence implicit_bndrs = [] + -- + -- When there are only /implicit/ binders, added by the renamer, e.g. + -- f :: a -> t a -> t a + -- then bring those implicit binders into scope here. + + let body_hs_ty :: LHsType GhcRn + implicit_bndrs :: [Name] + (implicit_bndrs, body_hs_ty) + = case outer_bndrs of + HsOuterExplicit { hso_bndrs = bndrs } + -> ([], L loc $ + HsForAllTy { hst_xforall = noExtField + , hst_tele = HsForAllInvis { hsf_xinvis = noExtField + , hsf_invis_bndrs = bndrs } + , hst_body = hs_ty }) + HsOuterImplicit { hso_ximplicit = implicit_bndrs } + -> (implicit_bndrs, hs_ty) + + ; (tc_lvl, (wanted, (implicit_tkvs, ty))) + <- pushTcLevelM $ + solveLocalEqualitiesX "tc_hs_sig_type" $ -- See Note [Failure in local type signatures] - bindOuterSigTKBndrs_Skol outer_bndrs $ + bindImplicitTKBndrs_Skol implicit_bndrs $ do { kind <- newExpectedKind ctxt_kind - ; tcLHsType hs_ty kind } + ; tcLHsType body_hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- 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 mkInvisForAllTys imp_or_exp_tkvs ty + ; implicit_tkvs <- zonkAndScopedSort implicit_tkvs + ; let ty1 = mkSpecForAllTys implicit_tkvs ty -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, -- but constraints are so much simpler in kinds, it is much @@ -446,10 +424,7 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- Build an implication for any as-yet-unsolved kind equalities -- See Note [Skolem escape in type signatures] - ; implic <- buildTvImplication skol_info - (kvs ++ either id binderVars imp_or_exp_tkvs) tc_lvl wanted - -- TODO RGS: The line above can put /visible/ foralls in a tyvar implication. - -- I'm not sure if that's kosher. + ; implic <- buildTvImplication skol_info (kvs ++ implicit_tkvs) tc_lvl wanted ; return (implic, mkInfForAllTys kvs ty1) } @@ -1050,7 +1025,7 @@ tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind <- pushLevelAndCaptureConstraints $ bindExplicitTKTele_Skol_M mode tele $ -- The _M variant passes on the mode from the type, to - -- any wildards in kind signatures on the forall'd variables + -- any wildcards in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah tc_lhs_type mode ty exp_kind -- Why exp_kind? See Note [Body kind of HsForAllTy] ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -163,21 +163,28 @@ simplifyTop wanteds solveLocalEqualities :: String -> TcM a -> TcM a -- Note [Failure in local type signatures] solveLocalEqualities callsite thing_inside - = do { (wanted, res) <- solveLocalEqualitiesX callsite thing_inside + = do { traceTc "solveLocalEqualities {" (vcat [ text "Called from" <+> text callsite ]) + ; (res, wanted) <- captureConstraints thing_inside ; emitFlatConstraints wanted + ; traceTc "solveLocalEqualitie }" empty ; return res } emitFlatConstraints :: WantedConstraints -> TcM () -- See Note [Failure in local type signatures] emitFlatConstraints wanted - = do { wanted <- TcM.zonkWC wanted + = do { -- Solve and zonk to esablish the + -- preconditions for floatKindEqualities + wanted <- runTcSEqualities (solveWanteds wanted) + ; wanted <- TcM.zonkWC wanted + + ; traceTc "emitFlatConstraints {" (ppr wanted) ; case floatKindEqualities wanted of - Nothing -> do { traceTc "emitFlatConstraints: failing" (ppr wanted) + Nothing -> do { traceTc "emitFlatConstraints } failing" (ppr wanted) ; emitConstraints wanted -- So they get reported! ; failM } Just (simples, holes) -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples) - ; traceTc "emitFlatConstraints:" $ + ; traceTc "emitFlatConstraints }" $ vcat [ text "simples:" <+> ppr simples , text "holes: " <+> ppr holes ] ; emitHoles holes -- Holes don't need promotion @@ -188,6 +195,11 @@ floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag Hole) -- Return Nothing if any constraints can't be floated (captured -- by skolems), or if there is an insoluble constraint, or -- IC_Telescope telescope error +-- Precondition 1: we have tried to solve the 'wanteds', both so that +-- the ic_status field is set, and because solving can make constraints +-- more floatable. +-- Precondition 2: the 'wanteds' are zonked, since floatKindEqualities +-- is not monadic floatKindEqualities wc = float_wc emptyVarSet wc where float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag Hole) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1235,7 +1235,7 @@ all at once, creating one implication constraint for the lot: that binds existentials, where the type of the data constructor is known to be valid (it in tcConPat), no need for the check. - So the check is done if and only if ic_info is ForAllSkol + So the check is done /if and only if/ ic_info is ForAllSkol. * If ic_info is (ForAllSkol dt dvs), the dvs::SDoc displays the original, user-written type variables. @@ -1245,6 +1245,18 @@ all at once, creating one implication constraint for the lot: constraint solver a chance to make that bad-telescope test! Hence the extra guard in emitResidualTvConstraint; see #16247 +* Don't mix up inferred and explicit variables in the same implication + constraint. E.g. + foo :: forall a kx (b :: kx). SameKind a b + We want an implication + Implic { ic_skol = [(a::kx), kx, (b::kx)], ... } + but GHC will attempt to quantify over kx, since it is free in (a::kx), + and it's hopelessly confusing to report an error about quantified + variables kx (a::kx) kx (b::kx). + Instead, the outer quantification over kx should be in a separate + implication. TL;DR: an explicit forall should generate an implication + quantified only over those explicitly quantified variables. + Note [Needed evidence variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Th ic_need_evs field holds the free vars of ic_binds, and all the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9004c100c4ded5fe0894e957b857eed95bb07605 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9004c100c4ded5fe0894e957b857eed95bb07605 You're receiving 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 21 15:07:02 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Mon, 21 Sep 2020 11:07:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/linear-types-syntax Message-ID: <5f68c1961a33a_80b10e6e6f4134672b8@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/linear-types-syntax at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/linear-types-syntax You're receiving 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 21 15:19:28 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Mon, 21 Sep 2020 11:19:28 -0400 Subject: [Git][ghc/ghc][wip/T18223] 10 commits: Resolve shift/reduce conflicts with %shift (#17232) Message-ID: <5f68c48051e5e_80b3f846986e87c13468976@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18223 at Glasgow Haskell Compiler / GHC Commits: 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - ff5a843e by Simon Peyton Jones at 2020-09-21T16:15:14+01:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 28 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Parser.y - libraries/base/tests/Concurrent/ThreadDelay001.hs - libraries/base/tests/all.T - testsuite/driver/testlib.py - testsuite/tests/driver/all.T - testsuite/tests/ghci/linking/dyn/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/T16473.stdout - + testsuite/tests/perf/compiler/T18223.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/rts/T12771/all.T - testsuite/tests/rts/T13082/all.T - testsuite/tests/rts/T14611/all.T - testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 - testsuite/tests/simplCore/should_compile/T17966.stdout - testsuite/tests/stranal/should_compile/T18122.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -31,7 +31,7 @@ module GHC.Core.Coercion ( mkAxInstRHS, mkUnbranchedAxInstRHS, mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, - mkSymCo, mkTransCo, mkTransMCo, + mkSymCo, mkTransCo, mkNthCo, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, @@ -65,7 +65,8 @@ module GHC.Core.Coercion ( pickLR, isGReflCo, isReflCo, isReflCo_maybe, isGReflCo_maybe, isReflexiveCo, isReflexiveCo_maybe, - isReflCoVar_maybe, isGReflMCo, coToMCo, + isReflCoVar_maybe, isGReflMCo, + coToMCo, mkTransMCo, mkTransMCoL, -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, @@ -288,6 +289,44 @@ tidyCoAxBndrsForUser init_env tcvs ('_' : rest) -> all isDigit rest _ -> False + +{- ********************************************************************* +* * + MCoercion +* * +********************************************************************* -} + +coToMCo :: Coercion -> MCoercion +-- Convert a coercion to a MCoercion, +-- It's not clear whether or not isReflexiveCo would be better here +coToMCo co | isReflCo co = MRefl + | otherwise = MCo co + +-- | Tests if this MCoercion is obviously generalized reflexive +-- Guaranteed to work very quickly. +isGReflMCo :: MCoercion -> Bool +isGReflMCo MRefl = True +isGReflMCo (MCo co) | isGReflCo co = True +isGReflMCo _ = False + +-- | Make a generalized reflexive coercion +mkGReflCo :: Role -> Type -> MCoercionN -> Coercion +mkGReflCo r ty mco + | isGReflMCo mco = if r == Nominal then Refl ty + else GRefl r ty MRefl + | otherwise = GRefl r ty mco + +-- | Compose two MCoercions via transitivity +mkTransMCo :: MCoercion -> MCoercion -> MCoercion +mkTransMCo MRefl co2 = co2 +mkTransMCo co1 MRefl = co1 +mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2) + +mkTransMCoL :: MCoercion -> Coercion -> MCoercion +mkTransMCoL MRefl co2 = MCo co2 +mkTransMCoL (MCo co1) co2 = MCo (mkTransCo co1 co2) + + {- %************************************************************************ %* * @@ -556,13 +595,6 @@ isGReflCo (GRefl{}) = True isGReflCo (Refl{}) = True -- Refl ty == GRefl N ty MRefl isGReflCo _ = False --- | Tests if this MCoercion is obviously generalized reflexive --- Guaranteed to work very quickly. -isGReflMCo :: MCoercion -> Bool -isGReflMCo MRefl = True -isGReflMCo (MCo co) | isGReflCo co = True -isGReflMCo _ = False - -- | Tests if this coercion is obviously reflexive. Guaranteed to work -- very quickly. Sometimes a coercion can be reflexive, but not obviously -- so. c.f. 'isReflexiveCo' @@ -603,10 +635,6 @@ isReflexiveCo_maybe co = Nothing where (Pair ty1 ty2, r) = coercionKindRole co -coToMCo :: Coercion -> MCoercion -coToMCo c = if isReflCo c - then MRefl - else MCo c {- %************************************************************************ @@ -669,13 +697,6 @@ role is bizarre and a caller should have to ask for this behavior explicitly. -} --- | Make a generalized reflexive coercion -mkGReflCo :: Role -> Type -> MCoercionN -> Coercion -mkGReflCo r ty mco - | isGReflMCo mco = if r == Nominal then Refl ty - else GRefl r ty MRefl - | otherwise = GRefl r ty mco - -- | Make a reflexive coercion mkReflCo :: Role -> Type -> Coercion mkReflCo Nominal ty = Refl ty @@ -990,12 +1011,6 @@ mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo co1 co2 = TransCo co1 co2 --- | Compose two MCoercions via transitivity -mkTransMCo :: MCoercion -> MCoercion -> MCoercion -mkTransMCo MRefl co2 = co2 -mkTransMCo co1 MRefl = co1 -mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2) - mkNthCo :: HasDebugCallStack => Role -- The role of the coercion you're creating -> Int -- Zero-indexed ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -15,10 +15,18 @@ module GHC.Core.Opt.Arity ( manifestArity, joinRhsArity, exprArity, typeArity , exprEtaExpandArity, findRhsArity , etaExpand, etaExpandAT - , etaExpandToJoinPoint, etaExpandToJoinPointRule , exprBotStrictness_maybe + + -- ** ArityType , ArityType(..), expandableArityType, arityTypeArity , maxWithArity, isBotArityType, idArityType + + -- ** Join points + , etaExpandToJoinPoint, etaExpandToJoinPointRule + + -- ** Coercions and casts + , pushCoArg, pushCoArgs, pushCoValArg, pushCoTyArg + , pushCoercionIntoLambda, pushCoDataCon, collectBindersPushingCo ) where @@ -31,15 +39,21 @@ import GHC.Driver.Ppr import GHC.Core import GHC.Core.FVs import GHC.Core.Utils -import GHC.Core.Subst import GHC.Types.Demand import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Id -import GHC.Core.Type as Type -import GHC.Core.TyCon ( initRecTc, checkRecTc ) + +-- We have two sorts of substitution: +-- GHC.Core.Subst.Subst, and GHC.Core.TyCo.TCvSubst +-- Both have substTy, substCo Hence need for qualification +import GHC.Core.Subst as Core +import GHC.Core.Type as Type +import GHC.Core.Coercion as Type + +import GHC.Core.DataCon +import GHC.Core.TyCon ( initRecTc, checkRecTc, tyConArity ) import GHC.Core.Predicate ( isDictTy ) -import GHC.Core.Coercion as Coercion import GHC.Core.Multiplicity import GHC.Types.Var.Set import GHC.Types.Basic @@ -48,7 +62,8 @@ import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Utils.Misc ( lengthAtLeast ) +import GHC.Data.Pair +import GHC.Utils.Misc {- ************************************************************************ @@ -1076,12 +1091,11 @@ eta_expand one_shots orig_expr go oss (Cast expr co) = Cast (go oss expr) co go oss expr - = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $ - retick $ etaInfoAbs etas (etaInfoApp subst' sexpr etas) + = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, pprEtaInfos etas]) $ + retick $ etaInfoAbs etas (etaInfoApp in_scope' sexpr etas) where in_scope = mkInScopeSet (exprFreeVars expr) (in_scope', etas) = mkEtaWW oss (ppr orig_expr) in_scope (exprType expr) - subst' = mkEmptySubst in_scope' -- Find ticks behind type apps. -- See Note [Eta expansion and source notes] @@ -1090,76 +1104,197 @@ eta_expand one_shots orig_expr sexpr = foldl' App expr'' args retick expr = foldr mkTick expr ticks - -- Abstraction Application +{- ********************************************************************* +* * + The EtaInfo mechanism + mkEtaWW, etaInfoAbs, etaInfoApp +* * +********************************************************************* -} + +{- Note [The EtaInfo mechanism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have (e :: ty) and we want to eta-expand it to arity N. +This what eta_expand does. We do it in two steps: + +1. mkEtaWW: from 'ty' and 'N' build a [EtaInfo] which describes + the shape of the expansion necessary to expand to arity N. + +2. Build the term + \ v1..vn. e v1 .. vn + where those abstractions and applications are described by + the same [EtaInfo]. Specifically we build the term + + etaInfoAbs etas (etaInfoApp in_scope e etas) + + where etas :: [EtaInfo]# + etaInfoAbs builds the lambdas + etaInfoApp builds the applictions + + Note that the /same/ [EtaInfo] drives both etaInfoAbs and etaInfoApp + +To a first approximation [EtaInfo] is just [Var]. But +casts complicate the question. If we have + newtype N a = MkN (S -> a) +and + ty = N (N Int) +then the eta-expansion must look like + (\x (\y. ((e |> co1) x) |> co2) y) + |> sym co2) + |> sym co1 +where + co1 :: N (N Int) ~ S -> N Int + co2 :: N Int ~ S -> Int + +Blimey! Look at all those casts. Moreover, if the type +is very deeply nested (as happens in #18223), the repetition +of types can make the overall term very large. So there is a big +payoff in cancelling out casts aggressively wherever possible. +(See also Note [No crap in eta-expanded code].) + +This matters a lot in etaEInfoApp, where we +* Do beta-reduction on the fly +* Use getARg_mabye to get a cast out of the way, + so that we can do beta reduction +Together this makes a big difference. Consider when e is + case x of + True -> (\x -> e1) |> c1 + False -> (\p -> e2) |> c2 + +When we eta-expand this to arity 1, say, etaInfoAbs will wrap +a (\eta) around the outside and use etaInfoApp to apply each +alternative to 'eta'. We want to beta-reduce all that junk +away. + +#18223 was a dramtic example in which the intermediate term was +grotesquely huge, even though the next Simplifier iteration squashed +it. Better to kill it at birth. +-} + -------------- -data EtaInfo = EtaVar Var -- /\a. [] [] a - -- \x. [] [] x - | EtaCo Coercion -- [] |> sym co [] |> co +data EtaInfo -- Abstraction Application + = EtaVar Var -- /\a. [] [] a + -- (\x. []) [] x + | EtaCo CoercionR -- [] |> sym co [] |> co instance Outputable EtaInfo where - ppr (EtaVar v) = text "EtaVar" <+> ppr v - ppr (EtaCo co) = text "EtaCo" <+> ppr co + ppr (EtaVar v) = text "EtaVar" <+> ppr v <+> dcolon <+> ppr (idType v) + ppr (EtaCo co) = text "EtaCo" <+> hang (ppr co) 2 (dcolon <+> ppr (coercionType co)) + +-- Used in debug-printing +-- pprEtaInfos :: [EtaInfo] -> SDoc +-- pprEtaInfos eis = brackets $ vcat $ punctuate comma $ map ppr eis pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo] +-- Puts a EtaCo on the front of a [EtaInfo], but combining +-- with an existing EtaCo if possible +-- A minor improvement pushCoercion co1 (EtaCo co2 : eis) | isReflCo co = eis | otherwise = EtaCo co : eis where co = co1 `mkTransCo` co2 -pushCoercion co eis = EtaCo co : eis +pushCoercion co eis + = EtaCo co : eis + +getArg_maybe :: [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) +-- Get an argument to the front of the [EtaInfo], if possible, +-- by pushing any EtaCo through the argument +getArg_maybe eis = go MRefl eis + where + go :: MCoercion -> [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) + go _ [] = Nothing + go mco (EtaCo co2 : eis) = go (mkTransMCoL mco co2) eis + go MRefl (EtaVar v : eis) = Just (varToCoreExpr v, eis) + go (MCo co) (EtaVar v : eis) + | Just (arg, mco) <- pushCoArg co (varToCoreExpr v) + = case mco of + MRefl -> Just (arg, eis) + MCo co -> Just (arg, pushCoercion co eis) + | otherwise + = Nothing + +mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr +mkCastMCo e MRefl = e +mkCastMCo e (MCo co) = Cast e co + -- We are careful to use (MCo co) only when co is not reflexive + -- Hence (Cast e co) rather than (mkCast e co) + +mkPiMCo :: Var -> MCoercionR -> MCoercionR +mkPiMCo _ MRefl = MRefl +mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) -------------- etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr -etaInfoAbs [] expr = expr -etaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr) -etaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCo co) +-- See Note [The EtaInfo mechanism] +etaInfoAbs eis expr + | null eis = expr + | otherwise = case final_mco of + MRefl -> expr' + MCo co -> mkCast expr' co + where + (expr', final_mco) = foldr do_one (split_cast expr) eis + + do_one :: EtaInfo -> (CoreExpr, MCoercion) -> (CoreExpr, MCoercion) + -- Implements the "Abstraction" column in the comments for data EtaInfo + -- In both argument and result the pair (e,mco) denotes (e |> mco) + do_one (EtaVar v) (expr, mco) = (Lam v expr, mkPiMCo v mco) + do_one (EtaCo co) (expr, mco) = (expr, mco `mkTransMCoL` mkSymCo co) + + split_cast :: CoreExpr -> (CoreExpr, MCoercion) + split_cast (Cast e co) = (e, MCo co) + split_cast e = (e, MRefl) + -- We could look in the body of lets, and the branches of a case + -- But then we would have to worry about whether the cast mentioned + -- any of the bound variables, which is tiresome. Later maybe. + -- Result: we may end up with + -- (\(x::Int). case x of { DEFAULT -> e1 |> co }) |> sym (->co) + -- and fail to optimise it away -------------- -etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr +etaInfoApp :: InScopeSet -> CoreExpr -> [EtaInfo] -> CoreExpr -- (etaInfoApp s e eis) returns something equivalent to --- ((substExpr s e) `appliedto` eis) - -etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis) - = etaInfoApp (GHC.Core.Subst.extendSubstWithVar subst v1 v2) e eis - -etaInfoApp subst (Cast e co1) eis - = etaInfoApp subst e (pushCoercion co' eis) - where - co' = GHC.Core.Subst.substCo subst co1 +-- (substExpr s e `appliedto` eis) +-- See Note [The EtaInfo mechanism] -etaInfoApp subst (Case e b ty alts) eis - = Case (subst_expr subst e) b1 ty' alts' +etaInfoApp in_scope expr eis + = go (mkEmptySubst in_scope) expr eis where - (subst1, b1) = substBndr subst b - alts' = map subst_alt alts - ty' = etaInfoAppTy (GHC.Core.Subst.substTy subst ty) eis - subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis) - where - (subst2,bs') = substBndrs subst1 bs - -etaInfoApp subst (Let b e) eis - | not (isJoinBind b) - -- See Note [Eta expansion for join points] - = Let b' (etaInfoApp subst' e eis) - where - (subst', b') = substBindSC subst b + go :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr + -- 'go' pushed down the eta-infos into the branch of a case + -- and the body of a let; and does beta-reduction if possible + go subst (Tick t e) eis + = Tick (substTickish subst t) (go subst e eis) + go subst (Cast e co) eis + = go subst e (pushCoercion (Core.substCo subst co) eis) + go subst (Case e b ty alts) eis + = Case (Core.substExprSC subst e) b1 ty' alts' + where + (subst1, b1) = Core.substBndr subst b + alts' = map subst_alt alts + ty' = etaInfoAppTy (Core.substTy subst ty) eis + subst_alt (con, bs, rhs) = (con, bs', go subst2 rhs eis) + where + (subst2,bs') = Core.substBndrs subst1 bs + go subst (Let b e) eis + | not (isJoinBind b) -- See Note [Eta expansion for join points] + = Let b' (go subst' e eis) + where + (subst', b') = Core.substBindSC subst b -etaInfoApp subst (Tick t e) eis - = Tick (substTickish subst t) (etaInfoApp subst e eis) + -- Beta-reduction if possible, using getArg_maybe to push + -- any intervening casts past the argument + -- See Note [The EtaInfo mechansim] + go subst (Lam v e) eis + | Just (arg, eis') <- getArg_maybe eis + = go (Core.extendSubst subst v arg) e eis' -etaInfoApp subst expr _ - | (Var fun, _) <- collectArgs expr - , Var fun' <- lookupIdSubst subst fun - , isJoinId fun' - = subst_expr subst expr + -- Stop pushing down; just wrap the expression up + go subst e eis = wrap (Core.substExprSC subst e) eis -etaInfoApp subst e eis - = go (subst_expr subst e) eis - where - go e [] = e - go e (EtaVar v : eis) = go (App e (varToCoreExpr v)) eis - go e (EtaCo co : eis) = go (Cast e co) eis + wrap e [] = e + wrap e (EtaVar v : eis) = wrap (App e (varToCoreExpr v)) eis + wrap e (EtaCo co : eis) = wrap (Cast e co) eis -------------- @@ -1235,7 +1370,7 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty -- We want to get -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x) | Just (co, ty') <- topNormaliseNewType_maybe ty - , let co' = Coercion.substCo subst co + , let co' = Type.substCo subst co -- Remember to apply the substitution to co (#16979) -- (or we could have applied to ty, but then -- we'd have had to zap it for the recursive call) @@ -1253,21 +1388,290 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty -- with an explicit lambda having a non-function type +{- ********************************************************************* +* * + The "push rules" +* * +************************************************************************ ------------- -subst_expr :: Subst -> CoreExpr -> CoreExpr --- Apply a substitution to an expression. We use substExpr --- not substExprSC (short-cutting substitution) because --- we may be changing the types of join points, so applying --- the in-scope set is necessary. +Here we implement the "push rules" from FC papers: + +* The push-argument rules, where we can move a coercion past an argument. + We have + (fun |> co) arg + and we want to transform it to + (fun arg') |> co' + for some suitable co' and transformed arg'. + +* The PushK rule for data constructors. We have + (K e1 .. en) |> co + and we want to transform to + (K e1' .. en') + by pushing the coercion into the arguments +-} + +pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion) +pushCoArgs co [] = return ([], MCo co) +pushCoArgs co (arg:args) = do { (arg', m_co1) <- pushCoArg co arg + ; case m_co1 of + MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args + ; return (arg':args', m_co2) } + MRefl -> return (arg':args, MRefl) } + +pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) +-- We have (fun |> co) arg, and we want to transform it to +-- (fun arg) |> co +-- This may fail, e.g. if (fun :: N) where N is a newtype +-- C.f. simplCast in GHC.Core.Opt.Simplify +-- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive +pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty + ; return (Type ty', m_co') } +pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co + ; return (val_arg `mkCastMCo` arg_co, m_co') } + +pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) +-- We have (fun |> co) @ty +-- Push the coercion through to return +-- (fun @ty') |> co' +-- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive; +-- it's faster not to compute it, though. +pushCoTyArg co ty + -- The following is inefficient - don't do `eqType` here, the coercion + -- optimizer will take care of it. See #14737. + -- -- | tyL `eqType` tyR + -- -- = Just (ty, Nothing) + + | isReflCo co + = Just (ty, MRefl) + + | isForAllTy_ty tyL + = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty ) + Just (ty `mkCastTy` co1, MCo co2) + + | otherwise + = Nothing + where + Pair tyL tyR = coercionKind co + -- co :: tyL ~ tyR + -- tyL = forall (a1 :: k1). ty1 + -- tyR = forall (a2 :: k2). ty2 + + co1 = mkSymCo (mkNthCo Nominal 0 co) + -- co1 :: k2 ~N k1 + -- Note that NthCo can extract a Nominal equality between the + -- kinds of the types related by a coercion between forall-types. + -- See the NthCo case in GHC.Core.Lint. + + co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) + -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] + -- Arg of mkInstCo is always nominal, hence mkNomReflCo + +pushCoValArg :: CoercionR -> Maybe (MCoercionR, MCoercionR) +-- We have (fun |> co) arg +-- Push the coercion through to return +-- (fun (arg |> co_arg)) |> co_res +-- 'co' is always Representational +-- If the second returned Coercion is actually Nothing, then no cast is necessary; +-- the returned coercion would have been reflexive. +pushCoValArg co + -- The following is inefficient - don't do `eqType` here, the coercion + -- optimizer will take care of it. See #14737. + -- -- | tyL `eqType` tyR + -- -- = Just (mkRepReflCo arg, Nothing) + + | isReflCo co + = Just (MRefl, MRefl) + + | isFunTy tyL + , (co_mult, co1, co2) <- decomposeFunCo Representational co + , isReflexiveCo co_mult + -- We can't push the coercion in the case where co_mult isn't reflexivity: + -- it could be an unsafe axiom, and losing this information could yield + -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) + -- with co :: (Int -> ()) ~ (Int #-> ()), would reduce to (fun x ::(1) Int + -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed + + -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) + -- then co1 :: tyL1 ~ tyR1 + -- co2 :: tyL2 ~ tyR2 + = ASSERT2( isFunTy tyR, ppr co $$ ppr arg ) + Just (coToMCo (mkSymCo co1), coToMCo co2) + -- Critically, coToMCo to checks for ReflCo; the whole coercion may not + -- be reflexive, but either of its components might be + -- We could use isReflexiveCo, but it's not clear if the benefit + -- is worth the cost, and it makes no difference in #18223 + + | otherwise + = Nothing + where + arg = funArgTy tyR + Pair tyL tyR = coercionKind co + +pushCoercionIntoLambda + :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) +-- This implements the Push rule from the paper on coercions +-- (\x. e) |> co +-- ===> +-- (\x'. e |> co') +pushCoercionIntoLambda in_scope x e co + | ASSERT(not (isTyVar x) && not (isCoVar x)) True + , Pair s1s2 t1t2 <- coercionKind co + , Just (_, _s1,_s2) <- splitFunTy_maybe s1s2 + , Just (w1, t1,_t2) <- splitFunTy_maybe t1t2 + , (co_mult, co1, co2) <- decomposeFunCo Representational co + , isReflexiveCo co_mult + -- We can't push the coercion in the case where co_mult isn't + -- reflexivity. See pushCoValArg for more details. + = let + -- Should we optimize the coercions here? + -- Otherwise they might not match too well + x' = x `setIdType` t1 `setIdMult` w1 + in_scope' = in_scope `extendInScopeSet` x' + subst = extendIdSubst (mkEmptySubst in_scope') + x + (mkCast (Var x') co1) + in Just (x', substExpr subst e `mkCast` co2) + | otherwise + = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e)) + Nothing + +pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion + -> Maybe (DataCon + , [Type] -- Universal type args + , [CoreExpr]) -- All other args incl existentials +-- Implement the KPush reduction rule as described in "Down with kinds" +-- The transformation applies iff we have +-- (C e1 ... en) `cast` co +-- where co :: (T t1 .. tn) ~ to_ty +-- The left-hand one must be a T, because exprIsConApp returned True +-- but the right-hand one might not be. (Though it usually will.) +pushCoDataCon dc dc_args co + | isReflCo co || from_ty `eqType` to_ty -- try cheap test first + , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + = Just (dc, map exprToType univ_ty_args, rest_args) + + | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty + , to_tc == dataConTyCon dc + -- These two tests can fail; we might see + -- (C x y) `cast` (g :: T a ~ S [a]), + -- where S is a type function. In fact, exprIsConApp + -- will probably not be called in such circumstances, + -- but there's nothing wrong with it + + = let + tc_arity = tyConArity to_tc + dc_univ_tyvars = dataConUnivTyVars dc + dc_ex_tcvars = dataConExTyCoVars dc + arg_tys = dataConRepArgTys dc + + non_univ_args = dropList dc_univ_tyvars dc_args + (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args + + -- Make the "Psi" from the paper + omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) + (psi_subst, to_ex_arg_tys) + = liftCoSubstWithEx Representational + dc_univ_tyvars + omegas + dc_ex_tcvars + (map exprToType ex_args) + + -- Cast the value arguments (which include dictionaries) + new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args + cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) + + to_ex_args = map Type to_ex_arg_tys + + dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, + ppr arg_tys, ppr dc_args, + ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc + , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] + in + ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc ) + ASSERT2( equalLength val_args arg_tys, dump_doc ) + Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + + | otherwise + = Nothing + + where + Pair from_ty to_ty = coercionKind co + +collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) +-- Collect lambda binders, pushing coercions inside if possible +-- E.g. (\x.e) |> g g :: -> blah +-- = (\x. e |> Nth 1 g) +-- +-- That is, -- --- ToDo: we could instead check if we actually *are* --- changing any join points' types, and if not use substExprSC. -subst_expr = substExpr +-- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g) +collectBindersPushingCo e + = go [] e + where + -- Peel off lambdas until we hit a cast. + go :: [Var] -> CoreExpr -> ([Var], CoreExpr) + -- The accumulator is in reverse order + go bs (Lam b e) = go (b:bs) e + go bs (Cast e co) = go_c bs e co + go bs e = (reverse bs, e) + + -- We are in a cast; peel off casts until we hit a lambda. + go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr) + -- (go_c bs e c) is same as (go bs e (e |> c)) + go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2) + go_c bs (Lam b e) co = go_lam bs b e co + go_c bs e co = (reverse bs, mkCast e co) + + -- We are in a lambda under a cast; peel off lambdas and build a + -- new coercion for the body. + go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr) + -- (go_lam bs b e c) is same as (go_c bs (\b.e) c) + go_lam bs b e co + | isTyVar b + , let Pair tyL tyR = coercionKind co + , ASSERT( isForAllTy_ty tyL ) + isForAllTy_ty tyR + , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) + + | isCoVar b + , let Pair tyL tyR = coercionKind co + , ASSERT( isForAllTy_co tyL ) + isForAllTy_co tyR + , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + , let cov = mkCoVarCo b + = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) + + | isId b + , let Pair tyL tyR = coercionKind co + , ASSERT( isFunTy tyL) isFunTy tyR + , (co_mult, co_arg, co_res) <- decomposeFunCo Representational co + , isReflCo co_mult -- See Note [collectBindersPushingCo] + , isReflCo co_arg -- See Note [collectBindersPushingCo] + = go_c (b:bs) e co_res + + | otherwise = (reverse bs, mkCast (Lam b e) co) +{- --------------- +Note [collectBindersPushingCo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We just look for coercions of form + # w -> blah +(and similarly for foralls) to keep this function simple. We could do +more elaborate stuff, but it'd involve substitution etc. + +-} + +{- ********************************************************************* +* * + Join points +* * +********************************************************************* -} +------------------- -- | Split an expression into the given number of binders and a body, -- eta-expanding if necessary. Counts value *and* type binders. etaExpandToJoinPoint :: JoinArity -> CoreExpr -> ([CoreBndr], CoreExpr) @@ -1307,7 +1711,7 @@ etaBodyForJoinPoint need_args body = (reverse rev_bs, e) go n ty subst rev_bs e | Just (tv, res_ty) <- splitForAllTy_maybe ty - , let (subst', tv') = Type.substVarBndr subst tv + , let (subst', tv') = substVarBndr subst tv = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv') | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty , let (subst', b) = freshEtaId n subst (Scaled mult arg_ty) @@ -1318,6 +1722,8 @@ etaBodyForJoinPoint need_args body init_subst e = mkEmptyTCvSubst (mkInScopeSet (exprFreeVars e)) + + -------------- freshEtaId :: Int -> TCvSubst -> Scaled Type -> (TCvSubst, Id) -- Make a fresh Id, with specified type (after applying substitution) @@ -1336,3 +1742,4 @@ freshEtaId n subst ty -- "OrCoVar" since this can be used to eta-expand -- coercion abstractions subst' = extendTCvInScope subst eta_id' + ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -315,33 +315,38 @@ getCoreToDo dflags runWhen do_float_in CoreDoFloatInwards, + simplify "final", -- Final tidy-up + maybe_rule_check FinalPhase, + -------- After this we have -O2 passes ----------------- + -- None of them run with -O + -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. - runWhen liberate_case (CoreDoPasses [ - CoreLiberateCase, - simplify "post-liberate-case" - ]), -- Run the simplifier after LiberateCase to vastly - -- reduce the possibility of shadowing - -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr + runWhen liberate_case $ CoreDoPasses + [ CoreLiberateCase, simplify "post-liberate-case" ], + -- Run the simplifier after LiberateCase to vastly + -- reduce the possibility of shadowing + -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr - runWhen spec_constr CoreDoSpecConstr, + runWhen spec_constr $ CoreDoPasses + [ CoreDoSpecConstr, simplify "post-spec-constr"], + -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, - runWhen late_specialise - (CoreDoPasses [ CoreDoSpecialising - , simplify "post-late-spec"]), + runWhen late_specialise $ CoreDoPasses + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. - runWhen ((liberate_case || spec_constr) && cse) CoreCSE, + runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses + [ CoreCSE, simplify "post-final-cse" ], - -- Final clean-up simplification: - simplify "final", + --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( dmd_cpr_ww ++ [simplify "post-late-ww"] @@ -410,6 +415,27 @@ or with -O0. Two reasons: But watch out: list fusion can prevent floating. So use phase control to switch off those rules until after floating. +Note [Simplify after SpecConstr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want to run the simplifier after SpecConstr, and before late-Specialise, +for two reasons, both shown up in test perf/compiler/T16473, +with -O2 -flate-specialise + +1. I found that running late-Specialise after SpecConstr, with no + simplification in between meant that the carefullly constructed + SpecConstr rule never got to fire. (It was something like + lvl = f a -- Arity 1 + ....g lvl.... + SpecConstr specialised g for argument lvl; but Specialise then + specialised lvl = f a to lvl = $sf, and inlined. Or something like + that.) + +2. Specialise relies on unfoldings being available for top-level dictionary + bindings; but SpecConstr kills them all! The Simplifer restores them. + +This extra run of the simplifier has a cost, but this is only with -O2. + + ************************************************************************ * * The CoreToDo interpreter ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -51,9 +51,9 @@ import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType + , pushCoTyArg, pushCoValArg , idArityType, etaExpandAT ) -import GHC.Core.SimpleOpt ( pushCoTyArg, pushCoValArg - , joinPointBinding_maybe, joinPointBindings_maybe ) +import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) import GHC.Types.Basic @@ -318,7 +318,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se ; let rhs_cont = mkRhsStop (substTy body_env (exprType body)) ; (body_floats0, body0) <- {-#SCC "simplExprF" #-} simplExprF body_env body rhs_cont - -- Never float join-floats out of a non-join let-binding + -- Never float join-floats out of a non-join let-binding (which this is) -- So wrap the body in the join-floats right now -- Hence: body_floats1 consists only of let-floats ; let (body_floats1, body1) = wrapJoinFloatsX body_floats0 body0 @@ -1414,25 +1414,23 @@ simplCast env body co0 cont0 -- type of the hole changes (#16312) -- (f |> co) e ===> (f (e |> co1)) |> co2 - -- where co :: (s1->s2) ~ (t1~t2) + -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 -- co2 :: s2 ~ t2 addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup, sc_cont = tail }) - | Just (co1, m_co2) <- pushCoValArg co - , let new_ty = coercionRKind co1 - , not (isTypeLevPoly new_ty) -- Without this check, we get a lev-poly arg - -- See Note [Levity polymorphism invariants] in GHC.Core - -- test: typecheck/should_run/EtaExpandLevPoly + | Just (m_co1, m_co2) <- pushCoValArg co + , levity_ok m_co1 = {-#SCC "addCoerce-pushCoValArg" #-} do { tail' <- addCoerceM m_co2 tail - ; if isReflCo co1 - then return (cont { sc_cont = tail' - , sc_hole_ty = coercionLKind co }) + ; case m_co1 of { + MRefl -> return (cont { sc_cont = tail' + , sc_hole_ty = coercionLKind co }) ; -- Avoid simplifying if possible; -- See Note [Avoiding exponential behaviour] - else do - { (dup', arg_se', arg') <- simplArg env dup arg_se arg + + MCo co1 -> + do { (dup', arg_se', arg') <- simplArg env dup arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1442,7 +1440,7 @@ simplCast env body co0 cont0 , sc_env = arg_se' , sc_dup = dup' , sc_cont = tail' - , sc_hole_ty = coercionLKind co }) } } + , sc_hole_ty = coercionLKind co }) } } } addCoerce co cont | isReflexiveCo co = return cont -- Having this at the end makes a huge @@ -1450,6 +1448,13 @@ simplCast env body co0 cont0 -- See Note [Optimising reflexivity] | otherwise = return (CastIt co cont) + levity_ok :: MCoercionR -> Bool + levity_ok MRefl = True + levity_ok (MCo co) = not $ isTypeLevPoly $ coercionRKind co + -- Without this check, we get a lev-poly arg + -- See Note [Levity polymorphism invariants] in GHC.Core + -- test: typecheck/should_run/EtaExpandLevPoly + simplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr -> SimplM (DupFlag, StaticEnv, OutExpr) simplArg env dup_flag arg_env arg @@ -3114,7 +3119,7 @@ knownCon :: SimplEnv knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont = do { (floats1, env1) <- bind_args env bs dc_args - ; (floats2, env2) <- bind_case_bndr env1 + ; (floats2, env2) <- bind_case_bndr env1 ; (floats3, expr') <- simplExprF env2 rhs cont ; case dc_floats of [] -> @@ -3240,6 +3245,7 @@ altsWouldDup [_] = False altsWouldDup (alt:alts) | is_bot_alt alt = altsWouldDup alts | otherwise = not (all is_bot_alt alts) + -- otherwise case: first alt is non-bot, so all the rest must be bot where is_bot_alt (_,_,rhs) = exprIsDeadEnd rhs ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -596,7 +596,7 @@ addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats --- Flattens the floats from env2 into a single Rec group, +-- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff , sfJoinFloats = jbs ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -21,22 +21,21 @@ import GHC.Tc.Utils.TcType hiding( substTy ) import GHC.Core.Type hiding( substTy, extendTvSubstList ) import GHC.Core.Multiplicity import GHC.Core.Predicate -import GHC.Unit.Module( Module, HasModule(..) ) +import GHC.Unit.Module( Module ) import GHC.Core.Coercion( Coercion ) import GHC.Core.Opt.Monad import qualified GHC.Core.Subst as Core -import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Types.Var ( isLocalVar ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core import GHC.Core.Rules -import GHC.Core.SimpleOpt ( collectBindersPushingCo ) import GHC.Core.Utils ( exprIsTrivial, getIdFromTrivialExpr_maybe , mkCast, exprType ) import GHC.Core.FVs -import GHC.Core.Opt.Arity ( etaExpandToJoinPointRule ) +import GHC.Core.Opt.Arity ( collectBindersPushingCo + , etaExpandToJoinPointRule ) import GHC.Types.Unique.Supply import GHC.Types.Name import GHC.Types.Id.Make ( voidArgId, voidPrimId ) @@ -53,12 +52,9 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Utils.Monad.State import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) -import Control.Monad - {- ************************************************************************ * * @@ -592,28 +588,29 @@ specProgram guts@(ModGuts { mg_module = this_mod , mg_binds = binds }) = do { dflags <- getDynFlags + -- We need to start with a Subst that knows all the things + -- that are in scope, so that the substitution engine doesn't + -- accidentally re-use a unique that's already in use + -- Easiest thing is to do it all at once, as if all the top-level + -- decls were mutually recursive + ; let top_env = SE { se_subst = Core.mkEmptySubst $ mkInScopeSet $ mkVarSet $ + bindersOfBinds binds + , se_interesting = emptyVarSet + , se_module = this_mod + , se_dflags = dflags } + + go [] = return ([], emptyUDs) + go (bind:binds) = do (binds', uds) <- go binds + (bind', uds') <- specBind top_env bind uds + return (bind' ++ binds', uds') + -- Specialise the bindings of this module - ; (binds', uds) <- runSpecM dflags this_mod (go binds) + ; (binds', uds) <- runSpecM (go binds) - ; (spec_rules, spec_binds) <- specImports dflags this_mod top_env - local_rules uds + ; (spec_rules, spec_binds) <- specImports top_env local_rules uds ; return (guts { mg_binds = spec_binds ++ binds' , mg_rules = spec_rules ++ local_rules }) } - where - -- We need to start with a Subst that knows all the things - -- that are in scope, so that the substitution engine doesn't - -- accidentally re-use a unique that's already in use - -- Easiest thing is to do it all at once, as if all the top-level - -- decls were mutually recursive - top_env = SE { se_subst = Core.mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds binds - , se_interesting = emptyVarSet } - - go [] = return ([], emptyUDs) - go (bind:binds) = do (binds', uds) <- go binds - (bind', uds') <- specBind top_env bind uds - return (bind' ++ binds', uds') {- Note [Wrap bindings returned by specImports] @@ -643,13 +640,13 @@ See #10491 * * ********************************************************************* -} -specImports :: DynFlags -> Module -> SpecEnv +specImports :: SpecEnv -> [CoreRule] -> UsageDetails -> CoreM ([CoreRule], [CoreBind]) -specImports dflags this_mod top_env local_rules +specImports top_env local_rules (MkUD { ud_binds = dict_binds, ud_calls = calls }) - | not $ gopt Opt_CrossModuleSpecialise dflags + | not $ gopt Opt_CrossModuleSpecialise (se_dflags top_env) -- See Note [Disabling cross-module specialisation] = return ([], wrapDictBinds dict_binds []) @@ -657,8 +654,7 @@ specImports dflags this_mod top_env local_rules = do { hpt_rules <- getRuleBase ; let rule_base = extendRuleBaseList hpt_rules local_rules - ; (spec_rules, spec_binds) <- spec_imports dflags this_mod top_env - [] rule_base + ; (spec_rules, spec_binds) <- spec_imports top_env [] rule_base dict_binds calls -- Don't forget to wrap the specialized bindings with @@ -674,9 +670,7 @@ specImports dflags this_mod top_env local_rules } -- | Specialise a set of calls to imported bindings -spec_imports :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope +spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in scope -> [Id] -- Stack of imported functions being specialised -- See Note [specImport call stack] -> RuleBase -- Rules from this module and the home package @@ -686,8 +680,7 @@ spec_imports :: DynFlags -> CallDetails -- Calls for imported things -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings -spec_imports dflags this_mod top_env - callers rule_base dict_binds calls +spec_imports top_env callers rule_base dict_binds calls = do { let import_calls = dVarEnvElts calls -- ; debugTraceMsg (text "specImports {" <+> -- vcat [ text "calls:" <+> ppr import_calls @@ -701,16 +694,13 @@ spec_imports dflags this_mod top_env go _ [] = return ([], []) go rb (cis : other_calls) = do { -- debugTraceMsg (text "specImport {" <+> ppr cis) - ; (rules1, spec_binds1) <- spec_import dflags this_mod top_env - callers rb dict_binds cis + ; (rules1, spec_binds1) <- spec_import top_env callers rb dict_binds cis -- ; debugTraceMsg (text "specImport }" <+> ppr cis) ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) } -spec_import :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope +spec_import :: SpecEnv -- Passed in so that all top-level Ids are in scope -> [Id] -- Stack of imported functions being specialised -- See Note [specImport call stack] -> RuleBase -- Rules from this module @@ -719,8 +709,7 @@ spec_import :: DynFlags -> CallInfoSet -- Imported function and calls for it -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings -spec_import dflags this_mod top_env callers - rb dict_binds cis@(CIS fn _) +spec_import top_env callers rb dict_binds cis@(CIS fn _) | isIn "specImport" fn callers = return ([], []) -- No warning. This actually happens all the time -- when specialising a recursive function, because @@ -731,8 +720,7 @@ spec_import dflags this_mod top_env callers = do { -- debugTraceMsg (text "specImport:no valid calls") ; return ([], []) } - | wantSpecImport dflags unfolding - , Just rhs <- maybeUnfoldingTemplate unfolding + | Just rhs <- canSpecImport dflags fn = do { -- Get rules from the external package state -- We keep doing this in case we "page-fault in" -- more rules as we go along @@ -744,8 +732,8 @@ spec_import dflags this_mod top_env callers ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) <- do { -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs]) - ; runSpecM dflags this_mod $ - specCalls (Just this_mod) top_env rules_for_fn good_calls fn rhs } + ; runSpecM $ + specCalls True top_env rules_for_fn good_calls fn rhs } ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs] -- After the rules kick in we may get recursion, but -- we rely on a global GlomBinds to sort that out later @@ -753,7 +741,7 @@ spec_import dflags this_mod top_env callers -- Now specialise any cascaded calls -- ; debugTraceMsg (text "specImport 2" <+> (ppr fn $$ ppr rules1 $$ ppr spec_binds1)) - ; (rules2, spec_binds2) <- spec_imports dflags this_mod top_env + ; (rules2, spec_binds2) <- spec_imports top_env (fn:callers) (extendRuleBaseList rb rules1) (dict_binds `unionBags` dict_binds1) @@ -769,11 +757,34 @@ spec_import dflags this_mod top_env callers ; return ([], [])} where - unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + dflags = se_dflags top_env good_calls = filterCalls cis dict_binds -- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn -- See Note [Avoiding loops in specImports] +canSpecImport :: DynFlags -> Id -> Maybe CoreExpr +-- See Note [Specialise imported INLINABLE things] +canSpecImport dflags fn + | CoreUnfolding { uf_src = src, uf_tmpl = rhs } <- unf + , isStableSource src + = Just rhs -- By default, specialise only imported things that have a stable + -- unfolding; that is, have an INLINE or INLINABLE pragma + -- Specialise even INLINE things; it hasn't inlined yet, + -- so perhaps it never will. Moreover it may have calls + -- inside it that we want to specialise + + -- CoreUnfolding case does /not/ include DFunUnfoldings; + -- We only specialise DFunUnfoldings with -fspecialise-aggressively + -- See Note [Do not specialise imported DFuns] + + | gopt Opt_SpecialiseAggressively dflags + = maybeUnfoldingTemplate unf -- With -fspecialise-aggressively, specialise anything + -- with an unfolding, stable or not, DFun or not + + | otherwise = Nothing + where + unf = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + -- | Returns whether or not to show a missed-spec warning. -- If -Wall-missed-specializations is on, show the warning. -- Otherwise, if -Wmissed-specializations is on, only show a warning @@ -798,24 +809,47 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ]) -wantSpecImport :: DynFlags -> Unfolding -> Bool --- See Note [Specialise imported INLINABLE things] -wantSpecImport dflags unf - = case unf of - NoUnfolding -> False - BootUnfolding -> False - OtherCon {} -> False - DFunUnfolding {} -> True - CoreUnfolding { uf_src = src, uf_guidance = _guidance } - | gopt Opt_SpecialiseAggressively dflags -> True - | isStableSource src -> True - -- Specialise even INLINE things; it hasn't inlined yet, - -- so perhaps it never will. Moreover it may have calls - -- inside it that we want to specialise - | otherwise -> False -- Stable, not INLINE, hence INLINABLE -{- Note [Avoiding loops in specImports] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +{- Note [Do not specialise imported DFuns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticket #18223 shows that specialising calls of DFuns is can cause a huge +and entirely unnecessary blowup in program size. Consider a call to + f @[[[[[[[[T]]]]]]]] d1 x +where df :: C a => C [a] + d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1 + d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3 + ... +Now we'll specialise f's RHS, which may give rise to calls to 'g', +also overloaded, which we will specialise, and so on. However, if +we specialise the calls to dfC[], we'll generate specialised copies of +all methods of C, at all types; and the same for C's superclasses. + +And many of these specialised functions will never be called. We are +going to call the specialised 'f', and the specialised 'g', but DFuns +group functions into a tuple, many of whose elements may never be used. + +With deeply-nested types this can lead to a simply overwhelming number +of specialisations: see #18223 for a simple example (from the wild). +I measured the number of specialisations for various numbers of calls +of `flip evalStateT ()`, and got this + + Size after one simplification + #calls #SPEC rules Terms Types + 5 56 3100 10600 + 9 108 13660 77206 + +The real tests case has 60+ calls, which blew GHC out of the water. + +Solution: don't specialise DFuns. The downside is that if we end +up with (h (dfun d)), /and/ we don't specialise 'h', then we won't +pass to 'h' a tuple of specialised functions. + +However, the flag -fspecialise-aggressively (experimental, off by default) +allows DFuns to specialise as well. + +Note [Avoiding loops in specImports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We must take great care when specialising instance declarations (functions like $fOrdList) lest we accidentally build a recursive dictionary. See Note [Avoiding loops]. @@ -1003,6 +1037,9 @@ data SpecEnv -- Dict Ids that we know something about -- and hence may be worth specialising against -- See Note [Interesting dictionary arguments] + + , se_module :: Module + , se_dflags :: DynFlags } instance Outputable SpecEnv where @@ -1310,7 +1347,7 @@ specDefn :: SpecEnv specDefn env body_uds fn rhs = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds rules_for_me = idCoreRules fn - ; (rules, spec_defns, spec_uds) <- specCalls Nothing env rules_for_me + ; (rules, spec_defns, spec_uds) <- specCalls False env rules_for_me calls_for_me fn rhs ; return ( fn `addIdSpecialisations` rules , spec_defns @@ -1323,8 +1360,8 @@ specDefn env body_uds fn rhs -- body_uds_without_me --------------------------- -specCalls :: Maybe Module -- Just this_mod => specialising imported fn - -- Nothing => specialising local fn +specCalls :: Bool -- True => specialising imported fn + -- False => specialising local fn -> SpecEnv -> [CoreRule] -- Existing RULES for the fn -> [CallInfo] @@ -1339,7 +1376,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules , [(Id,CoreExpr)] -- Specialised definition , UsageDetails ) -- Usage details from specialised RHSs -specCalls mb_mod env existing_rules calls_for_me fn rhs +specCalls spec_imp env existing_rules calls_for_me fn rhs -- The first case is the interesting one | notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) @@ -1370,7 +1407,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs inl_act = inlinePragmaActivation inl_prag is_local = isLocalId fn is_dfun = isDFunId fn - + dflags = se_dflags env + ropts = initRuleOpts dflags + this_mod = se_module env -- Figure out whether the function has an INLINE pragma -- See Note [Inline specialisations] @@ -1412,8 +1451,6 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ -- return () - ; dflags <- getDynFlags - ; let ropts = initRuleOpts dflags ; if not useful -- No useful specialisation || already_covered ropts rules_acc rule_lhs_args then return spec_acc @@ -1441,17 +1478,15 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = Nothing ; spec_fn <- newSpecIdSM fn spec_fn_ty spec_join_arity - ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: -- forall x @b d1' d2'. -- f x @T1 @b @T2 d1' d2' = f1 x @b -- See Note [Specialising Calls] - herald = case mb_mod of - Nothing -- Specialising local fn - -> text "SPEC" - Just this_mod -- Specialising imported fn - -> text "SPEC/" <> ppr this_mod + herald | spec_imp = -- Specialising imported fn + text "SPEC/" <> ppr this_mod + | otherwise = -- Specialising local fn + text "SPEC" rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) @@ -2480,15 +2515,15 @@ mkCallUDs env f args res = mkCallUDs' env f args mkCallUDs' env f args - | not (want_calls_for f) -- Imported from elsewhere - || null ci_key -- No useful specialisation - -- See also Note [Specialisations already covered] + | wantCallsFor env f -- We want it, and... + , not (null ci_key) -- this call site has a useful specialisation + = -- pprTrace "mkCallUDs: keeping" _trace_doc + singleCall f ci_key + + | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc emptyUDs - | otherwise - = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key where _trace_doc = vcat [ppr f, ppr args, ppr ci_key] pis = fst $ splitPiTys $ idType f @@ -2525,12 +2560,23 @@ mkCallUDs' env f args mk_spec_arg _ (Anon VisArg _) = UnspecArg - want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) - -- For imported things, we gather call instances if - -- there is an unfolding that we could in principle specialise - -- We might still decide not to use it (consulting dflags) - -- in specImports - -- Use 'realIdUnfolding' to ignore the loop-breaker flag! +wantCallsFor :: SpecEnv -> Id -> Bool +wantCallsFor _env _f = True + -- We could reduce the size of the UsageDetails by being less eager + -- about collecting calls for LocalIds: there is no point for + -- ones that are lambda-bound. We can't decide this by looking at + -- the (absence of an) unfolding, because unfoldings for local + -- functions are discarded by cloneBindSM, so no local binder will + -- have an unfolding at this stage. We'd have to keep a candidate + -- set of let-binders. + -- + -- Not many lambda-bound variables have dictionary arguments, so + -- this would make little difference anyway. + -- + -- For imported Ids we could check for an unfolding, but we have to + -- do so anyway in canSpecImport, and it seems better to have it + -- all in one place. So we simply collect usage info for imported + -- overloaded functions. {- Note [Type determines value] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2780,55 +2826,12 @@ deleteCallsFor bs calls = delDVarEnvList calls bs ************************************************************************ -} -newtype SpecM a = SpecM (State SpecState a) deriving (Functor) - -data SpecState = SpecState { - spec_uniq_supply :: UniqSupply, - spec_module :: Module, - spec_dflags :: DynFlags - } - -instance Applicative SpecM where - pure x = SpecM $ return x - (<*>) = ap - -instance Monad SpecM where - SpecM x >>= f = SpecM $ do y <- x - case f y of - SpecM z -> - z - -instance MonadFail SpecM where - fail str = SpecM $ error str - -instance MonadUnique SpecM where - getUniqueSupplyM - = SpecM $ do st <- get - let (us1, us2) = splitUniqSupply $ spec_uniq_supply st - put $ st { spec_uniq_supply = us2 } - return us1 - - getUniqueM - = SpecM $ do st <- get - let (u,us') = takeUniqFromSupply $ spec_uniq_supply st - put $ st { spec_uniq_supply = us' } - return u - -instance HasDynFlags SpecM where - getDynFlags = SpecM $ liftM spec_dflags get - -instance HasModule SpecM where - getModule = SpecM $ liftM spec_module get - -runSpecM :: DynFlags -> Module -> SpecM a -> CoreM a -runSpecM dflags this_mod (SpecM spec) - = do us <- getUniqueSupplyM - let initialState = SpecState { - spec_uniq_supply = us, - spec_module = this_mod, - spec_dflags = dflags - } - return $ evalState spec initialState +type SpecM a = UniqSM a + +runSpecM :: SpecM a -> CoreM a +runSpecM thing_inside + = do { us <- getUniqueSupplyM + ; return (initUs_ us thing_inside) } mapAndCombineSM :: (a -> SpecM (b, UsageDetails)) -> [a] -> SpecM ([b], UsageDetails) mapAndCombineSM _ [] = return ([], emptyUDs) ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -161,15 +161,20 @@ pprOptCo co = sdocOption sdocSuppressCoercions $ \case True -> angleBrackets (text "Co:" <> int (coercionSize co)) False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)] +ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc +ppr_id_occ add_par id + | isJoinId id = add_par ((text "jump") <+> pp_id) + | otherwise = pp_id + where + pp_id = ppr id -- We could use pprPrefixOcc to print (+) etc, but this is + -- Core where we don't print things infix anyway, so doing + -- so just adds extra redundant parens + ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc -- The function adds parens in context that need -- an atomic value (e.g. function args) -ppr_expr add_par (Var name) - | isJoinId name = add_par ((text "jump") <+> pp_name) - | otherwise = pp_name - where - pp_name = pprPrefixOcc name +ppr_expr add_par (Var id) = ppr_id_occ add_par id ppr_expr add_par (Type ty) = add_par (text "TYPE:" <+> ppr ty) -- Weird ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co) ppr_expr add_par (Lit lit) = pprLiteral add_par lit @@ -212,8 +217,7 @@ ppr_expr add_par expr@(App {}) _ -> parens (hang fun_doc 2 pp_args) where - fun_doc | isJoinId f = text "jump" <+> ppr f - | otherwise = ppr f + fun_doc = ppr_id_occ noParens f _ -> parens (hang (pprParendExpr fun) 2 pp_args) } ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -18,17 +18,14 @@ module GHC.Core.SimpleOpt ( -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, - -- ** Coercions and casts - pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo ) where #include "HsVersions.h" import GHC.Prelude -import GHC.Core.Opt.Arity( etaExpandToJoinPoint ) - import GHC.Core +import GHC.Core.Opt.Arity import GHC.Core.Subst import GHC.Core.Utils import GHC.Core.FVs @@ -48,16 +45,12 @@ import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) -import GHC.Core.TyCon ( tyConArity ) -import GHC.Core.Multiplicity import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Types.Basic import GHC.Unit.Module ( Module ) -import GHC.Driver.Ppr import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Data.Pair import GHC.Utils.Misc import GHC.Data.Maybe ( orElse ) import GHC.Data.FastString @@ -782,6 +775,28 @@ a good cause. And it won't hurt other RULES and such that it comes across. ************************************************************************ -} +{- Note [Strictness and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + let f = \x. if x>200 then e1 else e1 + +and we know that f is strict in x. Then if we subsequently +discover that f is an arity-2 join point, we'll eta-expand it to + + let f = \x y. if x>200 then e1 else e1 + +and now it's only strict if applied to two arguments. So we should +adjust the strictness info. + +A more common case is when + + f = \x. error ".." + +and again its arity increases (#15517) +-} + + -- | Returns Just (bndr,rhs) if the binding is a join point: -- If it's a JoinId, just return it -- If it's not yet a JoinId but is always tail-called, @@ -815,27 +830,6 @@ joinPointBindings_maybe bndrs = mapM (uncurry joinPointBinding_maybe) bndrs -{- Note [Strictness and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - let f = \x. if x>200 then e1 else e1 - -and we know that f is strict in x. Then if we subsequently -discover that f is an arity-2 join point, we'll eta-expand it to - - let f = \x y. if x>200 then e1 else e1 - -and now it's only strict if applied to two arguments. So we should -adjust the strictness info. - -A more common case is when - - f = \x. error ".." - -and again its arity increases (#15517) --} - {- ********************************************************************* * * exprIsConApp_maybe @@ -1350,275 +1344,3 @@ exprIsLambda_maybe _ _e Nothing -{- ********************************************************************* -* * - The "push rules" -* * -************************************************************************ - -Here we implement the "push rules" from FC papers: - -* The push-argument rules, where we can move a coercion past an argument. - We have - (fun |> co) arg - and we want to transform it to - (fun arg') |> co' - for some suitable co' and transformed arg'. - -* The PushK rule for data constructors. We have - (K e1 .. en) |> co - and we want to transform to - (K e1' .. en') - by pushing the coercion into the arguments --} - -pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion) -pushCoArgs co [] = return ([], MCo co) -pushCoArgs co (arg:args) = do { (arg', m_co1) <- pushCoArg co arg - ; case m_co1 of - MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args - ; return (arg':args', m_co2) } - MRefl -> return (arg':args, MRefl) } - -pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) --- We have (fun |> co) arg, and we want to transform it to --- (fun arg) |> co --- This may fail, e.g. if (fun :: N) where N is a newtype --- C.f. simplCast in GHC.Core.Opt.Simplify --- 'co' is always Representational --- If the returned coercion is Nothing, then it would have been reflexive -pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty - ; return (Type ty', m_co') } -pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co - ; return (val_arg `mkCast` arg_co, m_co') } - -pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) --- We have (fun |> co) @ty --- Push the coercion through to return --- (fun @ty') |> co' --- 'co' is always Representational --- If the returned coercion is Nothing, then it would have been reflexive; --- it's faster not to compute it, though. -pushCoTyArg co ty - -- The following is inefficient - don't do `eqType` here, the coercion - -- optimizer will take care of it. See #14737. - -- -- | tyL `eqType` tyR - -- -- = Just (ty, Nothing) - - | isReflCo co - = Just (ty, MRefl) - - | isForAllTy_ty tyL - = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty ) - Just (ty `mkCastTy` co1, MCo co2) - - | otherwise - = Nothing - where - Pair tyL tyR = coercionKind co - -- co :: tyL ~ tyR - -- tyL = forall (a1 :: k1). ty1 - -- tyR = forall (a2 :: k2). ty2 - - co1 = mkSymCo (mkNthCo Nominal 0 co) - -- co1 :: k2 ~N k1 - -- Note that NthCo can extract a Nominal equality between the - -- kinds of the types related by a coercion between forall-types. - -- See the NthCo case in GHC.Core.Lint. - - co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) - -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] - -- Arg of mkInstCo is always nominal, hence mkNomReflCo - -pushCoValArg :: CoercionR -> Maybe (Coercion, MCoercion) --- We have (fun |> co) arg --- Push the coercion through to return --- (fun (arg |> co_arg)) |> co_res --- 'co' is always Representational --- If the second returned Coercion is actually Nothing, then no cast is necessary; --- the returned coercion would have been reflexive. -pushCoValArg co - -- The following is inefficient - don't do `eqType` here, the coercion - -- optimizer will take care of it. See #14737. - -- -- | tyL `eqType` tyR - -- -- = Just (mkRepReflCo arg, Nothing) - - | isReflCo co - = Just (mkRepReflCo arg, MRefl) - - | isFunTy tyL - , (co_mult, co1, co2) <- decomposeFunCo Representational co - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't reflexivity: - -- it could be an unsafe axiom, and losing this information could yield - -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) - -- with co :: (Int -> ()) ~ (Int #-> ()), would reduce to (fun x ::(1) Int - -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed - - -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) - -- then co1 :: tyL1 ~ tyR1 - -- co2 :: tyL2 ~ tyR2 - = ASSERT2( isFunTy tyR, ppr co $$ ppr arg ) - Just (mkSymCo co1, MCo co2) - - | otherwise - = Nothing - where - arg = funArgTy tyR - Pair tyL tyR = coercionKind co - -pushCoercionIntoLambda - :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) --- This implements the Push rule from the paper on coercions --- (\x. e) |> co --- ===> --- (\x'. e |> co') -pushCoercionIntoLambda in_scope x e co - | ASSERT(not (isTyVar x) && not (isCoVar x)) True - , Pair s1s2 t1t2 <- coercionKind co - , Just (_, _s1,_s2) <- splitFunTy_maybe s1s2 - , Just (w1, t1,_t2) <- splitFunTy_maybe t1t2 - , (co_mult, co1, co2) <- decomposeFunCo Representational co - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't - -- reflexivity. See pushCoValArg for more details. - = let - -- Should we optimize the coercions here? - -- Otherwise they might not match too well - x' = x `setIdType` t1 `setIdMult` w1 - in_scope' = in_scope `extendInScopeSet` x' - subst = extendIdSubst (mkEmptySubst in_scope') - x - (mkCast (Var x') co1) - in Just (x', substExpr subst e `mkCast` co2) - | otherwise - = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e)) - Nothing - -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion - -> Maybe (DataCon - , [Type] -- Universal type args - , [CoreExpr]) -- All other args incl existentials --- Implement the KPush reduction rule as described in "Down with kinds" --- The transformation applies iff we have --- (C e1 ... en) `cast` co --- where co :: (T t1 .. tn) ~ to_ty --- The left-hand one must be a T, because exprIsConApp returned True --- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args co - | isReflCo co || from_ty `eqType` to_ty -- try cheap test first - , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args - = Just (dc, map exprToType univ_ty_args, rest_args) - - | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty - , to_tc == dataConTyCon dc - -- These two tests can fail; we might see - -- (C x y) `cast` (g :: T a ~ S [a]), - -- where S is a type function. In fact, exprIsConApp - -- will probably not be called in such circumstances, - -- but there's nothing wrong with it - - = let - tc_arity = tyConArity to_tc - dc_univ_tyvars = dataConUnivTyVars dc - dc_ex_tcvars = dataConExTyCoVars dc - arg_tys = dataConRepArgTys dc - - non_univ_args = dropList dc_univ_tyvars dc_args - (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args - - -- Make the "Psi" from the paper - omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) - (psi_subst, to_ex_arg_tys) - = liftCoSubstWithEx Representational - dc_univ_tyvars - omegas - dc_ex_tcvars - (map exprToType ex_args) - - -- Cast the value arguments (which include dictionaries) - new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args - cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) - - to_ex_args = map Type to_ex_arg_tys - - dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, - ppr arg_tys, ppr dc_args, - ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc - , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] - in - ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc ) - ASSERT2( equalLength val_args arg_tys, dump_doc ) - Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) - - | otherwise - = Nothing - - where - Pair from_ty to_ty = coercionKind co - -collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) --- Collect lambda binders, pushing coercions inside if possible --- E.g. (\x.e) |> g g :: -> blah --- = (\x. e |> Nth 1 g) --- --- That is, --- --- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g) -collectBindersPushingCo e - = go [] e - where - -- Peel off lambdas until we hit a cast. - go :: [Var] -> CoreExpr -> ([Var], CoreExpr) - -- The accumulator is in reverse order - go bs (Lam b e) = go (b:bs) e - go bs (Cast e co) = go_c bs e co - go bs e = (reverse bs, e) - - -- We are in a cast; peel off casts until we hit a lambda. - go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr) - -- (go_c bs e c) is same as (go bs e (e |> c)) - go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2) - go_c bs (Lam b e) co = go_lam bs b e co - go_c bs e co = (reverse bs, mkCast e co) - - -- We are in a lambda under a cast; peel off lambdas and build a - -- new coercion for the body. - go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr) - -- (go_lam bs b e c) is same as (go_c bs (\b.e) c) - go_lam bs b e co - | isTyVar b - , let Pair tyL tyR = coercionKind co - , ASSERT( isForAllTy_ty tyL ) - isForAllTy_ty tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) - - | isCoVar b - , let Pair tyL tyR = coercionKind co - , ASSERT( isForAllTy_co tyL ) - isForAllTy_co tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] - , let cov = mkCoVarCo b - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) - - | isId b - , let Pair tyL tyR = coercionKind co - , ASSERT( isFunTy tyL) isFunTy tyR - , (co_mult, co_arg, co_res) <- decomposeFunCo Representational co - , isReflCo co_mult -- See Note [collectBindersPushingCo] - , isReflCo co_arg -- See Note [collectBindersPushingCo] - = go_c (b:bs) e co_res - - | otherwise = (reverse bs, mkCast (Lam b e) co) - -{- - -Note [collectBindersPushingCo] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We just look for coercions of form - # w -> blah -(and similarly for foralls) to keep this function simple. We could do -more elaborate stuff, but it'd involve substitution etc. - --} ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -343,6 +343,8 @@ instance Outputable Subst where substExprSC :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr -- Just like substExpr, but a no-op if the substitution is empty +-- Note that this does /not/ replace occurrences of free vars with +-- their canonical representatives in the in-scope set substExprSC subst orig_expr | isEmptySubst subst = orig_expr | otherwise = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $ @@ -628,6 +630,9 @@ substIdInfo subst new_id info ------------------ -- | Substitutes for the 'Id's within an unfolding +-- NB: substUnfolding /discards/ any unfolding without +-- without a Stable source. This is usually what we want, +-- but it may be a bit unexpected substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding -- Seq'ing on the returned Unfolding is enough to cause -- all the substitutions to happen completely ===================================== compiler/GHC/Parser.y ===================================== @@ -95,297 +95,398 @@ import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nil manyDataConTyCon) } -%expect 232 -- shift/reduce conflicts +%expect 0 -- shift/reduce conflicts -{- Last updated: 08 June 2020 +{- Note [shift/reduce conflicts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'happy' tool turns this grammar into an efficient parser that follows the +shift-reduce parsing model. There's a parse stack that contains items parsed so +far (both terminals and non-terminals). Every next token produced by the lexer +results in one of two actions: -If you modify this parser and add a conflict, please update this comment. -You can learn more about the conflicts by passing 'happy' the -i flag: + SHIFT: push the token onto the parse stack - happy -agc --strict compiler/GHC/Parser.y -idetailed-info + REDUCE: pop a few items off the parse stack and combine them + with a function (reduction rule) -How is this section formatted? Look up the state the conflict is -reported at, and copy the list of applicable rules (at the top, without the -rule numbers). Mark *** for the rule that is the conflicting reduction (that -is, the interpretation which is NOT taken). NB: Happy doesn't print a rule -in a state if it is empty, but you should include it in the list (you can -look these up in the Grammar section of the info file). +However, sometimes it's unclear which of the two actions to take. +Consider this code example: -Obviously the state numbers are not stable across modifications to the parser, -the idea is to reproduce enough information on each conflict so you can figure -out what happened if the states were renumbered. Try not to gratuitously move -productions around in this file. + if x then y else f z -------------------------------------------------------------------------------- - -state 60 contains 1 shift/reduce conflict. - - context -> btype . - *** type -> btype . - type -> btype . '->' ctype - - Conflicts: '->' - -------------------------------------------------------------------------------- - -state 61 contains 46 shift/reduce conflicts. - - *** btype -> tyapps . - tyapps -> tyapps . tyapp - - Conflicts: '_' ':' '~' '!' '.' '`' '{' '[' '(' '(#' '`' TYPEAPP - SIMPLEQUOTE VARID CONID VARSYM CONSYM QCONID QVARSYM QCONSYM - STRING INTEGER TH_ID_SPLICE '$(' TH_QUASIQUOTE TH_QQUASIQUOTE - and all the special ids. - -Example ambiguity: - 'if x then y else z :: F a' - -Shift parses as (per longest-parse rule): - 'if x then y else z :: (F a)' - -------------------------------------------------------------------------------- - -state 143 contains 14 shift/reduce conflicts. - - exp -> infixexp . '::' sigtype - exp -> infixexp . '-<' exp - exp -> infixexp . '>-' exp - exp -> infixexp . '-<<' exp - exp -> infixexp . '>>-' exp - *** exp -> infixexp . - infixexp -> infixexp . qop exp10 - - Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-' - '.' '`' '*' VARSYM CONSYM QVARSYM QCONSYM - -Examples of ambiguity: - 'if x then y else z -< e' - 'if x then y else z :: T' - 'if x then y else z + 1' (NB: '+' is in VARSYM) - -Shift parses as (per longest-parse rule): - 'if x then y else (z -< T)' - 'if x then y else (z :: T)' - 'if x then y else (z + 1)' - -------------------------------------------------------------------------------- +There are two ways to parse it: -state 146 contains 66 shift/reduce conflicts. + (if x then y else f) z + if x then y else (f z) - *** exp10 -> fexp . - fexp -> fexp . aexp - fexp -> fexp . TYPEAPP atype +How is this determined? At some point, the parser gets to the following state: - Conflicts: TYPEAPP and all the tokens that can start an aexp + parse stack: 'if' exp 'then' exp 'else' "f" + next token: "z" -Examples of ambiguity: - 'if x then y else f z' - 'if x then y else f @ z' +Scenario A (simplified): -Shift parses as (per longest-parse rule): - 'if x then y else (f z)' - 'if x then y else (f @ z)' + 1. REDUCE, parse stack: 'if' exp 'then' exp 'else' exp + next token: "z" + (Note that "f" reduced to exp here) -------------------------------------------------------------------------------- + 2. REDUCE, parse stack: exp + next token: "z" -state 200 contains 27 shift/reduce conflicts. + 3. SHIFT, parse stack: exp "z" + next token: ... - aexp2 -> TH_TY_QUOTE . tyvar - aexp2 -> TH_TY_QUOTE . gtycon - *** aexp2 -> TH_TY_QUOTE . + 4. REDUCE, parse stack: exp + next token: ... - Conflicts: two single quotes is error syntax with specific error message. + This way we get: (if x then y else f) z -Example of ambiguity: - 'x = ''' - 'x = ''a' - 'x = ''T' +Scenario B (simplified): -Shift parses as (per longest-parse rule): - 'x = ''a' - 'x = ''T' + 1. SHIFT, parse stack: 'if' exp 'then' exp 'else' "f" "z" + next token: ... -------------------------------------------------------------------------------- + 2. REDUCE, parse stack: 'if' exp 'then' exp 'else' exp + next token: ... -state 294 contains 1 shift/reduce conflicts. + 3. REDUCE, parse stack: exp + next token: ... - rule -> STRING . rule_activation rule_forall infixexp '=' exp + This way we get: if x then y else (f z) - Conflict: '[' (empty rule_activation reduces) +The end result is determined by the chosen action. When Happy detects this, it +reports a shift/reduce conflict. At the top of the file, we have the following +directive: -We don't know whether the '[' starts the activation or not: it -might be the start of the declaration with the activation being -empty. --SDM 1/4/2002 + %expect 0 -Example ambiguity: - '{-# RULE [0] f = ... #-}' +It means that we expect no unresolved shift/reduce conflicts in this grammar. +If you modify the grammar and get shift/reduce conflicts, follow the steps +below to resolve them. -We parse this as having a [0] rule activation for rewriting 'f', rather -a rule instructing how to rewrite the expression '[0] f'. +STEP ONE + is to figure out what causes the conflict. + That's where the -i flag comes in handy: -------------------------------------------------------------------------------- + happy -agc --strict compiler/GHC/Parser.y -idetailed-info -state 305 contains 1 shift/reduce conflict. + By analysing the output of this command, in a new file `detailed-info`, you + can figure out which reduction rule causes the issue. At the top of the + generated report, you will see a line like this: - *** type -> btype . - type -> btype . '->' ctype + state 147 contains 67 shift/reduce conflicts. - Conflict: '->' + Scroll down to section State 147 (in your case it could be a different + state). The start of the section lists the reduction rules that can fire + and shows their context: -Same as state 61 but without contexts. + exp10 -> fexp . (rule 492) + fexp -> fexp . aexp (rule 498) + fexp -> fexp . PREFIX_AT atype (rule 499) -------------------------------------------------------------------------------- + And then, for every token, it tells you the parsing action: -state 349 contains 1 shift/reduce conflicts. + ']' reduce using rule 492 + '::' reduce using rule 492 + '(' shift, and enter state 178 + QVARID shift, and enter state 44 + DO shift, and enter state 182 + ... - tup_exprs -> commas . tup_tail - sysdcon_nolist -> '(' commas . ')' - commas -> commas . ',' + But if you look closer, some of these tokens also have another parsing action + in parentheses: - Conflict: ')' (empty tup_tail reduces) + QVARID shift, and enter state 44 + (reduce using rule 492) -A tuple section with NO free variables '(,,)' is indistinguishable -from the Haskell98 data constructor for a tuple. Shift resolves in -favor of sysdcon, which is good because a tuple section will get rejected -if -XTupleSections is not specified. + That's how you know rule 492 is causing trouble. + Scroll back to the top to see what this rule is: -See also Note [ExplicitTuple] in GHC.Hs.Expr. + ---------------------------------- + Grammar + ---------------------------------- + ... + ... + exp10 -> fexp (492) + optSemi -> ';' (493) + ... + ... -------------------------------------------------------------------------------- + Hence the shift/reduce conflict is caused by this parser production: -state 407 contains 1 shift/reduce conflicts. + exp10 :: { ECP } + : '-' fexp { ... } + | fexp { ... } -- problematic rule - tup_exprs -> commas . tup_tail - sysdcon_nolist -> '(#' commas . '#)' - commas -> commas . ',' +STEP TWO + is to mark the problematic rule with the %shift pragma. This signals to + 'happy' that any shift/reduce conflicts involving this rule must be resolved + in favor of a shift. There's currently no dedicated pragma to resolve in + favor of the reduce. - Conflict: '#)' (empty tup_tail reduces) +STEP THREE + is to add a dedicated Note for this specific conflict, as is done for all + other conflicts below. +-} -Same as State 354 for unboxed tuples. +{- Note [%shift: rule_activation -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule -> STRING . rule_activation rule_foralls infixexp '=' exp -------------------------------------------------------------------------------- +Example: + {-# RULES "name" [0] f = rhs #-} -state 416 contains 66 shift/reduce conflicts. +Ambiguity: + If we reduced, then we'd get an empty activation rule, and [0] would be + parsed as part of the left-hand side expression. - *** exp10 -> '-' fexp . - fexp -> fexp . aexp - fexp -> fexp . TYPEAPP atype + We shift, so [0] is parsed as an activation rule. +-} -Same as 146 but with a unary minus. +{- Note [%shift: rule_foralls -> 'forall' rule_vars '.'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule_foralls -> 'forall' rule_vars '.' . 'forall' rule_vars '.' + rule_foralls -> 'forall' rule_vars '.' . -------------------------------------------------------------------------------- +Example: + {-# RULES "name" forall a1. forall a2. lhs = rhs #-} -state 472 contains 1 shift/reduce conflict. +Ambiguity: + Same as in Note [%shift: rule_foralls -> {- empty -}] + but for the second 'forall'. +-} - oqtycon -> '(' qtyconsym . ')' - *** qtyconop -> qtyconsym . +{- Note [%shift: rule_foralls -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + rule -> STRING rule_activation . rule_foralls infixexp '=' exp - Conflict: ')' +Example: + {-# RULES "name" forall a1. lhs = rhs #-} -Example ambiguity: 'foo :: (:%)' +Ambiguity: + If we reduced, then we would get an empty rule_foralls; the 'forall', being + a valid term-level identifier, would be parsed as part of the left-hand + side expression. -Shift means '(:%)' gets parsed as a type constructor, rather than than a -parenthesized infix type expression of length 1. + We shift, so the 'forall' is parsed as part of rule_foralls. +-} -------------------------------------------------------------------------------- +{- Note [%shift: type -> btype] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + context -> btype . + type -> btype . + type -> btype . '->' ctype + type -> btype . '#->' ctype -state 665 contains 1 shift/reduce conflicts. +Example: + a :: Maybe Integer -> Bool - *** aexp2 -> ipvar . - dbind -> ipvar . '=' exp +Ambiguity: + If we reduced, we would get: (a :: Maybe Integer) -> Bool + We shift to get this instead: a :: (Maybe Integer -> Bool) +-} - Conflict: '=' +{- Note [%shift: infixtype -> ftype] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + infixtype -> ftype . + infixtype -> ftype . tyop infixtype + ftype -> ftype . tyarg + ftype -> ftype . PREFIX_AT tyarg + +Example: + a :: Maybe Integer + +Ambiguity: + If we reduced, we would get: (a :: Maybe) Integer + We shift to get this instead: a :: (Maybe Integer) +-} -Example ambiguity: 'let ?x ...' +{- Note [%shift: atype -> tyvar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + atype -> tyvar . + tv_bndr_no_braces -> '(' tyvar . '::' kind ')' -The parser can't tell whether the ?x is the lhs of a normal binding or -an implicit binding. Fortunately, resolving as shift gives it the only -sensible meaning, namely the lhs of an implicit binding. +Example: + class C a where type D a = (a :: Type ... -------------------------------------------------------------------------------- +Ambiguity: + If we reduced, we could specify a default for an associated type like this: -state 750 contains 1 shift/reduce conflicts. + class C a where type D a + type D a = (a :: Type) - rule -> STRING rule_activation . rule_forall infixexp '=' exp + But we shift in order to allow injectivity signatures like this: - Conflict: 'forall' (empty rule_forall reduces) + class C a where type D a = (r :: Type) | r -> a +-} -Example ambiguity: '{-# RULES "name" forall = ... #-}' +{- Note [%shift: exp -> infixexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp -> infixexp . '::' sigtype + exp -> infixexp . '-<' exp + exp -> infixexp . '>-' exp + exp -> infixexp . '-<<' exp + exp -> infixexp . '>>-' exp + exp -> infixexp . + infixexp -> infixexp . qop exp10p + +Examples: + 1) if x then y else z -< e + 2) if x then y else z :: T + 3) if x then y else z + 1 -- (NB: '+' is in VARSYM) + +Ambiguity: + If we reduced, we would get: + + 1) (if x then y else z) -< e + 2) (if x then y else z) :: T + 3) (if x then y else z) + 1 + + We shift to get this instead: + + 1) if x then y else (z -< e) + 2) if x then y else (z :: T) + 3) if x then y else (z + 1) +-} -'forall' is a valid variable name---we don't know whether -to treat a forall on the input as the beginning of a quantifier -or the beginning of the rule itself. Resolving to shift means -it's always treated as a quantifier, hence the above is disallowed. -This saves explicitly defining a grammar for the rule lhs that -doesn't include 'forall'. +{- Note [%shift: exp10 -> '-' fexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp10 -> '-' fexp . + fexp -> fexp . aexp + fexp -> fexp . PREFIX_AT atype -------------------------------------------------------------------------------- +Examples & Ambiguity: + Same as in Note [%shift: exp10 -> fexp], + but with a '-' in front. +-} -state 986 contains 1 shift/reduce conflicts. +{- Note [%shift: exp10 -> fexp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + exp10 -> fexp . + fexp -> fexp . aexp + fexp -> fexp . PREFIX_AT atype - transformqual -> 'then' 'group' . 'using' exp - transformqual -> 'then' 'group' . 'by' exp 'using' exp - *** special_id -> 'group' . +Examples: + 1) if x then y else f z + 2) if x then y else f @z - Conflict: 'by' +Ambiguity: + If we reduced, we would get: -------------------------------------------------------------------------------- + 1) (if x then y else f) z + 2) (if x then y else f) @z -state 1084 contains 1 shift/reduce conflicts. + We shift to get this instead: - rule_foralls -> 'forall' rule_vars '.' . 'forall' rule_vars '.' - *** rule_foralls -> 'forall' rule_vars '.' . + 1) if x then y else (f z) + 2) if x then y else (f @z) +-} - Conflict: 'forall' +{- Note [%shift: aexp2 -> ipvar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + aexp2 -> ipvar . + dbind -> ipvar . '=' exp -Example ambiguity: '{-# RULES "name" forall a. forall ... #-}' +Example: + let ?x = ... -Here the parser cannot tell whether the second 'forall' is the beginning of -a term-level quantifier, for example: +Ambiguity: + If we reduced, ?x would be parsed as the LHS of a normal binding, + eventually producing an error. -'{-# RULES "name" forall a. forall x. id @a x = x #-}' + We shift, so it is parsed as the LHS of an implicit binding. +-} -or a valid variable named 'forall', for example a function @:: Int -> Int@ +{- Note [%shift: aexp2 -> TH_TY_QUOTE] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + aexp2 -> TH_TY_QUOTE . tyvar + aexp2 -> TH_TY_QUOTE . gtycon + aexp2 -> TH_TY_QUOTE . -'{-# RULES "name" forall a. forall 0 = 0 #-}' +Examples: + 1) x = '' + 2) x = ''a + 3) x = ''T -Shift means the parser only allows the former. Also see conflict 753 above. +Ambiguity: + If we reduced, the '' would result in reportEmptyDoubleQuotes even when + followed by a type variable or a type constructor. But the only reason + this reduction rule exists is to improve error messages. -------------------------------------------------------------------------------- + Naturally, we shift instead, so that ''a and ''T work as expected. +-} -state 1285 contains 1 shift/reduce conflict. +{- Note [%shift: tup_tail -> {- empty -}] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + tup_exprs -> commas . tup_tail + sysdcon_nolist -> '(' commas . ')' + sysdcon_nolist -> '(#' commas . '#)' + commas -> commas . ',' - constrs1 -> constrs1 maybe_docnext '|' . maybe_docprev constr +Example: + (,,) - Conflict: DOCPREV +Ambiguity: + A tuple section with no components is indistinguishable from the Haskell98 + data constructor for a tuple. -------------------------------------------------------------------------------- + If we reduced, (,,) would be parsed as a tuple section. + We shift, so (,,) is parsed as a data constructor. -state 1375 contains 1 shift/reduce conflict. + This is preferable because we want to accept (,,) without -XTupleSections. + See also Note [ExplicitTuple] in GHC.Hs.Expr. +-} - *** atype -> tyvar . - tv_bndr -> '(' tyvar . '::' kind ')' +{- Note [%shift: qtyconop -> qtyconsym] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + oqtycon -> '(' qtyconsym . ')' + qtyconop -> qtyconsym . - Conflict: '::' +Example: + foo :: (:%) -Example ambiguity: 'class C a where type D a = ( a :: * ...' +Ambiguity: + If we reduced, (:%) would be parsed as a parenthehsized infix type + expression without arguments, resulting in the 'failOpFewArgs' error. -Here the parser cannot tell whether this is specifying a default for the -associated type like: + We shift, so it is parsed as a type constructor. +-} -'class C a where type D a = ( a :: * ); type D a' +{- Note [%shift: special_id -> 'group'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Context: + transformqual -> 'then' 'group' . 'using' exp + transformqual -> 'then' 'group' . 'by' exp 'using' exp + special_id -> 'group' . -or it is an injectivity signature like: +Example: + [ ... | then group by dept using groupWith + , then take 5 ] -'class C a where type D a = ( r :: * ) | r -> a' +Ambiguity: + If we reduced, 'group' would be parsed as a term-level identifier, just as + 'take' in the other clause. -Shift means the parser only allows the latter. + We shift, so it is parsed as part of the 'group by' clause introduced by + the -XTransformListComp extension. +-} -------------------------------------------------------------------------------- --- API Annotations --- +{- Note [Parser API Annotations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A lot of the productions are now cluttered with calls to aa,am,ams,amms etc. @@ -405,9 +506,10 @@ If you modify the parser and want to ensure that the API annotations are process correctly, see the README in (REPO)/utils/check-api-annotations for details on how to set up a test using the check-api-annotations utility, and interpret the output it generates. +-} -Note [Parsing lists] ---------------------- +{- Note [Parsing lists] +~~~~~~~~~~~~~~~~~~~~~~~ You might be wondering why we spend so much effort encoding our lists this way: @@ -447,9 +549,6 @@ are the most common patterns, rewritten as regular expressions for clarity: -- Equivalent to x (',' x)+ (non-empty, no trailing semis) xs : x | x ',' xs - --- ----------------------------------------------------------------------------- - -} %token @@ -1681,7 +1780,8 @@ rule :: { LRuleDecl GhcPs } -- Rules can be specified to be NeverActive, unlike inline/specialize pragmas rule_activation :: { ([AddAnn],Maybe Activation) } - : {- empty -} { ([],Nothing) } + -- See Note [%shift: rule_activation -> {- empty -}] + : {- empty -} %shift { ([],Nothing) } | rule_explicit_activation { (fst $1,Just (snd $1)) } -- This production is used to parse the tilde syntax in pragmas such as @@ -1717,9 +1817,12 @@ rule_foralls :: { ([AddAnn], Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs]) } >> return ([mu AnnForall $1,mj AnnDot $3, mu AnnForall $4,mj AnnDot $6], Just (mkRuleTyVarBndrs $2), mkRuleBndrs $5) } - | 'forall' rule_vars '.' { ([mu AnnForall $1,mj AnnDot $3], + + -- See Note [%shift: rule_foralls -> 'forall' rule_vars '.'] + | 'forall' rule_vars '.' %shift { ([mu AnnForall $1,mj AnnDot $3], Nothing, mkRuleBndrs $2) } - | {- empty -} { ([], Nothing, []) } + -- See Note [%shift: rule_foralls -> {- empty -}] + | {- empty -} %shift { ([], Nothing, []) } rule_vars :: { [LRuleTyTmVar] } : rule_var rule_vars { $1 : $2 } @@ -1953,7 +2056,8 @@ is connected to the first type too. -} type :: { LHsType GhcPs } - : btype { $1 } + -- See Note [%shift: type -> btype] + : btype %shift { $1 } | btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations] >> ams (sLL $1 $> $ HsFunTy noExtField HsUnrestrictedArrow $1 $3) [mu AnnRarrow $2] } @@ -1969,7 +2073,8 @@ btype :: { LHsType GhcPs } : infixtype {% runPV $1 } infixtype :: { forall b. DisambTD b => PV (Located b) } - : ftype { $1 } + -- See Note [%shift: infixtype -> ftype] + : ftype %shift { $1 } | ftype tyop infixtype { $1 >>= \ $1 -> $3 >>= \ $3 -> mkHsOpTyPV $1 $2 $3 } @@ -1998,7 +2103,8 @@ tyop :: { Located RdrName } atype :: { LHsType GhcPs } : ntgtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- Not including unit tuples - | tyvar { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples]) + -- See Note [%shift: atype -> tyvar] + | tyvar %shift { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } @@ -2482,7 +2588,8 @@ exp :: { ECP } ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1 HsHigherOrderApp False) [mu AnnRarrowtail $2] } - | infixexp { $1 } + -- See Note [%shift: exp -> infixexp] + | infixexp %shift { $1 } | exp_prag(exp) { $1 } -- See Note [Pragmas and operator fixity] infixexp :: { ECP } @@ -2510,11 +2617,13 @@ exp_prag(e) :: { ECP } (fst $ unLoc $1) } exp10 :: { ECP } - : '-' fexp { ECP $ + -- See Note [%shift: exp10 -> '-' fexp] + : '-' fexp %shift { ECP $ unECP $2 >>= \ $2 -> amms (mkHsNegAppPV (comb2 $1 $>) $2) [mj AnnMinus $1] } - | fexp { $1 } + -- See Note [%shift: exp10 -> fexp] + | fexp %shift { $1 } optSemi :: { ([Located Token],Bool) } : ';' { ([$1],True) } @@ -2690,7 +2799,8 @@ aexp1 :: { ECP } aexp2 :: { ECP } : qvar { ECP $ mkHsVarPV $! $1 } | qcon { ECP $ mkHsVarPV $! $1 } - | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) } + -- See Note [%shift: aexp2 -> ipvar] + | ipvar %shift { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) } | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExtField Nothing $! unLoc $1) } | literal { ECP $ mkHsLitPV $! $1 } -- This will enable overloaded strings permanently. Normally the renamer turns HsString @@ -2732,7 +2842,8 @@ aexp2 :: { ECP } | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } - | TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) } + -- See Note [%shift: aexp2 -> TH_TY_QUOTE] + | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (ExpBr noExtField $2)) @@ -2874,7 +2985,8 @@ tup_tail :: { forall b. DisambECP b => PV [Located (Maybe (Located b))] } return ((L (gl $1) (Just $1)) : snd $2) } | texp { unECP $1 >>= \ $1 -> return [L (gl $1) (Just $1)] } - | {- empty -} { return [noLoc Nothing] } + -- See Note [%shift: tup_tail -> {- empty -}] + | {- empty -} %shift { return [noLoc Nothing] } ----------------------------------------------------------------------------- -- List expressions @@ -3385,7 +3497,8 @@ child. -} qtyconop :: { Located RdrName } -- Qualified or unqualified - : qtyconsym { $1 } + -- See Note [%shift: qtyconop -> qtyconsym] + : qtyconsym %shift { $1 } | '`' qtycon '`' {% ams (sLL $1 $> (unLoc $2)) [mj AnnBackquote $1,mj AnnVal $2 ,mj AnnBackquote $3] } @@ -3552,7 +3665,8 @@ special_id | 'capi' { sL1 $1 (fsLit "capi") } | 'prim' { sL1 $1 (fsLit "prim") } | 'javascript' { sL1 $1 (fsLit "javascript") } - | 'group' { sL1 $1 (fsLit "group") } + -- See Note [%shift: special_id -> 'group'] + | 'group' %shift { sL1 $1 (fsLit "group") } | 'stock' { sL1 $1 (fsLit "stock") } | 'anyclass' { sL1 $1 (fsLit "anyclass") } | 'via' { sL1 $1 (fsLit "via") } ===================================== libraries/base/tests/Concurrent/ThreadDelay001.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} -- Test that threadDelay actually sleeps for (at least) as long as we -- ask it ===================================== libraries/base/tests/all.T ===================================== @@ -17,7 +17,10 @@ test('readFloat', exit_code(1), compile_and_run, ['']) test('enumDouble', normal, compile_and_run, ['']) test('enumRatio', normal, compile_and_run, ['']) test('enumNumeric', normal, compile_and_run, ['']) -test('tempfiles', normal, compile_and_run, ['']) +# N.B. the tempfile format is slightly different than this test expects on +# Windows *except* if using WinIO. The `when` clause below can be removed +# after WinIO becomes the default. +test('tempfiles', when(opsys('mingw32'), only_ways(['winio'])), compile_and_run, ['']) test('fixed', normal, compile_and_run, ['']) test('quotOverflow', normal, compile_and_run, ['']) test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts']) ===================================== testsuite/driver/testlib.py ===================================== @@ -751,22 +751,24 @@ def normalise_win32_io_errors(name, opts): slightly in the error messages that they provide. Normalise these differences away, preferring the new WinIO errors. - This can be dropped when the old IO manager is removed. + This normalization can be dropped when the old IO manager is removed. """ SUBS = [ - ('Bad file descriptor', 'The handle is invalid'), + ('Bad file descriptor', 'The handle is invalid.'), ('Permission denied', 'Access is denied.'), ('No such file or directory', 'The system cannot find the file specified.'), ] - def f(s: str): + def normalizer(s: str) -> str: for old,new in SUBS: s = s.replace(old, new) return s - return when(opsys('mingw32'), normalise_fun(f)) + if opsys('mingw32'): + _normalise_fun(name, opts, normalizer) + _normalise_errmsg_fun(name, opts, normalizer) def normalise_version_( *pkgs ): def normalise_version__( str ): ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) +test('T12971', ignore_stdout, makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== testsuite/tests/ghci/linking/dyn/all.T ===================================== @@ -30,10 +30,12 @@ test('T10458', ghci_script, ['T10458.script']) test('T11072gcc', [extra_files(['A.c', 'T11072.hs']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_gcc']) test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']), + expect_broken(18718), unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], makefile_test, ['compile_libAS_impl_msvc']) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -142,10 +142,10 @@ test('T5979', normalise_version("transformers")], ghci_script, ['T5979.script']) test('T5975a', - [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + 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'), when(opsys('mingw32'), expect_broken(7305))], + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -7,7 +7,3 @@ T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs -T16473: - $(RM) -f T16473.hi T16473.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs - ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -1,97 +1 @@ -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op liftA2 (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op <$ (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op get (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op >> (BUILTIN) -Rule fired: Class op put (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op get (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op >> (BUILTIN) -Rule fired: Class op put (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op show (BUILTIN) -Rule fired: Class op mempty (BUILTIN) -Rule fired: Class op fromInteger (BUILTIN) -Rule fired: Integer -> Int# (BUILTIN) -Rule fired: Class op <> (BUILTIN) -Rule fired: Class op + (BUILTIN) -Rule fired: Class op enumFromTo (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: fold/build (GHC.Base) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: ># (BUILTIN) -Rule fired: ==# (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: SPEC/Main $fMonadStateT_$c>>= @Identity _ (Main) -Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @Identity _ (Main) -Rule fired: SPEC/Main $fApplicativeStateT_$cpure @Identity _ (Main) -Rule fired: SPEC/Main $fFunctorStateT @Identity _ (Main) -Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main) -Rule fired: Class op fmap (BUILTIN) -Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op return (BUILTIN) +5050 ===================================== testsuite/tests/perf/compiler/T18223.hs ===================================== @@ -0,0 +1,78 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE Strict #-} + +import Control.Monad.State + +tester :: MonadState a m => m () +tester = modify' id + +-- manyState :: StateT () (StateT () IO) () -> IO () +-- manyState :: _ -> IO () +manyState x = + (flip evalStateT () -- 1 + . flip evalStateT () -- 2 + . flip evalStateT () -- 3 + . flip evalStateT () -- 4 + . flip evalStateT () -- 5 + . flip evalStateT () -- 6 + . flip evalStateT () -- 7 + . flip evalStateT () -- 8 + . flip evalStateT () -- 9 + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + ) x :: IO () + +main :: IO () +main = manyState tester >>= print ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -367,7 +367,13 @@ test('T16190', multimod_compile, ['T16190.hs', '-v0']) -test('T16473', normal, makefile_test, ['T16473']) +# Run this program. If specialisation fails, it'll start to allocate much more +test ('T16473', + [ collect_stats('bytes allocated',5) + , only_ways(['normal']) + ], + compile_and_run, + ['-O2 -flate-specialise']) test('T17516', [ collect_compiler_stats('bytes allocated', 5), @@ -415,3 +421,8 @@ test ('T13253-spj', ], compile, ['-v0 -O']) +test ('T18223', + [ collect_compiler_stats('bytes allocated',2) + ], + compile, + ['-v0 -O']) ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -20,7 +20,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} (+++) :: forall {a}. [a] -> [a] -> [a] [GblId] -(+++) = (++) +(+++) = ++ -- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} T18052a.$m:||: ===================================== testsuite/tests/rts/T12771/all.T ===================================== @@ -1,4 +1,5 @@ test('T12771', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T12771']) ===================================== testsuite/tests/rts/T13082/all.T ===================================== @@ -16,6 +16,7 @@ def normalise_search_dirs (str): #-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T13082_good']) ===================================== testsuite/tests/rts/T14611/all.T ===================================== @@ -1,4 +1,5 @@ test('T14611', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + expect_broken(18718), unless(opsys('mingw32'), skip)], makefile_test, ['T14611']) ===================================== testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32 ===================================== @@ -1 +1 @@ -outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. +outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete. ===================================== testsuite/tests/simplCore/should_compile/T17966.stdout ===================================== @@ -1,5 +1,2 @@ RULES: "SPEC $cm @()" [0] RULES: "SPEC f @Bool @() @(Maybe Integer)" [0] -"SPEC/T17966 $fShowMaybe_$cshow @Integer" -"SPEC/T17966 $fShowMaybe_$cshowList @Integer" -"SPEC/T17966 $fShowMaybe @Integer" ===================================== testsuite/tests/stranal/should_compile/T18122.stderr ===================================== @@ -13,9 +13,8 @@ Lib.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Lib.$trModule3 :: GHC.Types.TrName [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule3 = GHC.Types.TrNameS Lib.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} @@ -28,27 +27,25 @@ Lib.$trModule2 = "Lib"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Lib.$trModule1 :: GHC.Types.TrName [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule1 = GHC.Types.TrNameS Lib.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Lib.$trModule :: GHC.Types.Module [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule = GHC.Types.Module Lib.$trModule3 Lib.$trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Lib.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=2, Str=, Unf=OtherCon []] -Lib.$wfoo = (GHC.Prim.+#) +Lib.$wfoo = GHC.Prim.+# -- RHS size: {terms: 18, types: 14, coercions: 0, joins: 0/0} -foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int +foo [InlPrag=NOUSERINLINE[final]] :: (Int, Int) -> Int -> Int [GblId, Arity=2, Str=, @@ -56,24 +53,25 @@ foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_sHs [Occ=Once!] :: (Int, Int)) - (w1_sHt [Occ=Once!] :: Int) -> - case w_sHs of { (ww1_sHw [Occ=Once!], _ [Occ=Dead]) -> - case ww1_sHw of { GHC.Types.I# ww4_sHz [Occ=Once] -> - case w1_sHt of { GHC.Types.I# ww6_sHF [Occ=Once] -> - case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww7_sHJ + Tmpl= \ (w_sEf [Occ=Once1!] :: (Int, Int)) + (w1_sEg [Occ=Once1!] :: Int) -> + case w_sEf of { (ww1_sEj [Occ=Once1!], _ [Occ=Dead]) -> + case ww1_sEj of { GHC.Types.I# ww4_sEm [Occ=Once1] -> + case w1_sEg of { GHC.Types.I# ww6_sEs [Occ=Once1] -> + case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw [Occ=Once1] + { __DEFAULT -> + GHC.Types.I# ww7_sEw } } } }}] foo - = \ (w_sHs :: (Int, Int)) (w1_sHt :: Int) -> - case w_sHs of { (ww1_sHw, ww2_sHB) -> - case ww1_sHw of { GHC.Types.I# ww4_sHz -> - case w1_sHt of { GHC.Types.I# ww6_sHF -> - case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ { __DEFAULT -> - GHC.Types.I# ww7_sHJ + = \ (w_sEf :: (Int, Int)) (w1_sEg :: Int) -> + case w_sEf of { (ww1_sEj, ww2_sEo) -> + case ww1_sEj of { GHC.Types.I# ww4_sEm -> + case w1_sEg of { GHC.Types.I# ww6_sEs -> + case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw { __DEFAULT -> + GHC.Types.I# ww7_sEw } } } ===================================== testsuite/tests/th/all.T ===================================== @@ -51,7 +51,8 @@ test('TH_NestedSplices', [], multimod_compile, # normal way first, which is why the work is done by a Makefile rule. test('TH_spliceE5_prof', [req_profiling, only_ways(['normal']), - when(ghc_dynamic(), expect_broken(11495))], + when(ghc_dynamic(), expect_broken(11495)), + when(opsys('mingw32'), expect_broken(18271))], makefile_test, ['TH_spliceE5_prof']) test('TH_spliceE5_prof_ext', [req_profiling, only_ways(['normal'])], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d360aa35bf3e23539b96f24f65197a4c17a343d4...ff5a843e2003abed15f99d10eb1195cf9d572e06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d360aa35bf3e23539b96f24f65197a4c17a343d4...ff5a843e2003abed15f99d10eb1195cf9d572e06 You're receiving 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 21 15:19:57 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 11:19:57 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f68c49da936a_80b109f99201346958b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 43087e1d by Sebastian Graf at 2020-09-21T17:19:04+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * The `abs_binds` of an `AbsBinds` post type-checking, or * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. There's a regression test in `T18626`. Fixes #18626. - - - - - 3 changed files: - compiler/GHC/HsToCore/PmCheck.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -142,7 +142,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -322,7 +322,11 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of local binds for long-distance +-- information and the actual list of 'GRHS'. +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -363,6 +367,10 @@ instance Outputable (PmMatch Pre) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = pprLygGuards grds <+> ppr grhss +instance Outputable (PmGRHSs Pre) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Pre) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs @@ -388,6 +396,10 @@ instance Outputable (PmMatch Post) where ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = pprRedSets red <+> ppr grhss +instance Outputable (PmGRHSs Post) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Post) where ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = pprRedSets red <+> text "->" <+> pprSrcInfo rhs @@ -699,12 +711,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -724,7 +738,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM GrdVec desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -732,9 +746,30 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec -desugarLet _binds = return [] +-- | Desugar local (let and where) bindings +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM GrdVec +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + -- We are only interested in FunBinds with single match groups without any + -- patterns. + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{abs_exports=exports, abs_binds = binds}) = do + -- Just assign polymorphic binders the same semantics as their monomorphic + -- counterpart. This is crucial for making sense about any HsLocalBinds at + -- all. + let go_export :: ABExport GhcTc -> PmGrd + go_export ABE{abe_poly = x, abe_mono = y} = PmLet x (Var y) + let exps = map go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -1019,8 +1054,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = @@ -1085,7 +1121,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -1161,8 +1200,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -142,6 +142,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('T18626', 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, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43087e1d64b5d7174f7039b0be35aeaadb5326db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43087e1d64b5d7174f7039b0be35aeaadb5326db You're receiving 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 21 15:50:48 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Mon, 21 Sep 2020 11:50:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/infer-mult-more Message-ID: <5f68cbd86726e_80b3f837b63ed2013484055@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/infer-mult-more at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/infer-mult-more You're receiving 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 21 15:51:10 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Mon, 21 Sep 2020 11:51:10 -0400 Subject: [Git][ghc/ghc][wip/infer-mult-more] Make 'undefined x' linear in 'x' (#18731) Message-ID: <5f68cbee534be_80b3f8442a0fce8134873b5@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/infer-mult-more at Glasgow Haskell Compiler / GHC Commits: 2b7656dc by Krzysztof Gogolewski at 2020-09-21T17:51:00+02:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 5 changed files: - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - + testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/typecheck/should_fail/T7869.stderr Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -340,9 +340,10 @@ matchActualFunTySigma herald ct_orig mb_thing err_info fun_ty defer fun_ty = do { arg_ty <- newOpenFlexiTyVarTy ; res_ty <- newOpenFlexiTyVarTy - ; let unif_fun_ty = mkVisFunTyMany arg_ty res_ty + ; mult <- newFlexiTyVarTy multiplicityTy + ; let unif_fun_ty = mkVisFunTy mult arg_ty res_ty ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, unrestricted arg_ty, res_ty) } + ; return (mkWpCastN co, Scaled mult arg_ty, res_ty) } ------------ mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 136961 + Total ticks: 140801 ===================================== testsuite/tests/linear/should_compile/T18731.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE LinearTypes #-} +module T18731 where + +f :: a #-> b +f x = undefined x ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -35,3 +35,4 @@ test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, [''] test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('T18731', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T7869.stderr ===================================== @@ -1,16 +1,18 @@ T7869.hs:3:12: error: - • Couldn't match type ‘b1’ with ‘b’ + • Couldn't match type ‘a1’ with ‘a’ Expected: [a1] -> b1 Actual: [a] -> b - ‘b1’ is a rigid type variable bound by + ‘a1’ is a rigid type variable bound by an expression type signature: forall a1 b1. [a1] -> b1 at T7869.hs:3:20-27 - ‘b’ is a rigid type variable bound by + ‘a’ is a rigid type variable bound by the inferred type of f :: [a] -> b at T7869.hs:3:1-27 • In the expression: f x In the expression: (\ x -> f x) :: [a] -> b In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b - • Relevant bindings include f :: [a] -> b (bound at T7869.hs:3:1) + • Relevant bindings include + x :: [a1] (bound at T7869.hs:3:7) + f :: [a] -> b (bound at T7869.hs:3:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b7656dc542a94894b46c08bd8cb8a11ab4acd35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b7656dc542a94894b46c08bd8cb8a11ab4acd35 You're receiving 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 21 16:07:14 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 21 Sep 2020 12:07:14 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f68cfb255fef_80ba02ab70135025bf@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 9d298eaa by Sebastian Graf at 2020-09-21T18:07:04+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * The `abs_binds` of an `AbsBinds` post type-checking, or * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. There's a regression test in `T18626`. Fixes #18626. - - - - - 3 changed files: - compiler/GHC/HsToCore/PmCheck.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -142,7 +142,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -322,7 +322,11 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of local binds for long-distance +-- information and the actual list of 'GRHS'. +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -363,6 +367,10 @@ instance Outputable (PmMatch Pre) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = pprLygGuards grds <+> ppr grhss +instance Outputable (PmGRHSs Pre) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Pre) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs @@ -388,6 +396,10 @@ instance Outputable (PmMatch Post) where ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = pprRedSets red <+> ppr grhss +instance Outputable (PmGRHSs Post) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Post) where ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = pprRedSets red <+> text "->" <+> pprSrcInfo rhs @@ -699,12 +711,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -724,7 +738,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM GrdVec desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -732,9 +746,32 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec -desugarLet _binds = return [] +-- | Desugar local (let and where) bindings +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM GrdVec +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + -- We are only interested in FunBinds with single match groups without any + -- patterns. + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{abs_exports=exports, abs_binds = binds}) = do + -- Just assign polymorphic binders the same semantics as their monomorphic + -- counterpart if their types match. This is crucial for making sense + -- about any HsLocalBinds at all. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y} + | idType x `eqType` idType y = Just $ PmLet x (Var y) + | otherwise = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -1019,8 +1056,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = @@ -1085,7 +1123,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -1161,8 +1202,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -142,6 +142,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('T18626', 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, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d298eaa613609cd11546ca57ec4bbacfac97920 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d298eaa613609cd11546ca57ec4bbacfac97920 You're receiving 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 21 16:09:20 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Mon, 21 Sep 2020 12:09:20 -0400 Subject: [Git][ghc/ghc][wip/infer-mult-more] Make 'undefined x' linear in 'x' (#18731) Message-ID: <5f68d03093df2_80bf0d48a0135029a8@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/infer-mult-more at Glasgow Haskell Compiler / GHC Commits: 83047a10 by Krzysztof Gogolewski at 2020-09-21T18:09:03+02:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 5 changed files: - compiler/GHC/Tc/Utils/Unify.hs - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - + testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/typecheck/should_fail/T7869.stderr Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -340,9 +340,12 @@ matchActualFunTySigma herald ct_orig mb_thing err_info fun_ty defer fun_ty = do { arg_ty <- newOpenFlexiTyVarTy ; res_ty <- newOpenFlexiTyVarTy - ; let unif_fun_ty = mkVisFunTyMany arg_ty res_ty + ; mult <- newFlexiTyVarTy multiplicityTy + -- We need a new variable for multiplicity (#18731) + -- Otherwise, 'undefined x' wouldn't be linear in x + ; let unif_fun_ty = mkVisFunTy mult arg_ty res_ty ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, unrestricted arg_ty, res_ty) } + ; return (mkWpCastN co, Scaled mult arg_ty, res_ty) } ------------ mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 136961 + Total ticks: 140801 ===================================== testsuite/tests/linear/should_compile/T18731.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE LinearTypes #-} +module T18731 where + +f :: a #-> b +f x = undefined x ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -35,3 +35,4 @@ test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, [''] test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('T18731', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T7869.stderr ===================================== @@ -1,16 +1,18 @@ T7869.hs:3:12: error: - • Couldn't match type ‘b1’ with ‘b’ + • Couldn't match type ‘a1’ with ‘a’ Expected: [a1] -> b1 Actual: [a] -> b - ‘b1’ is a rigid type variable bound by + ‘a1’ is a rigid type variable bound by an expression type signature: forall a1 b1. [a1] -> b1 at T7869.hs:3:20-27 - ‘b’ is a rigid type variable bound by + ‘a’ is a rigid type variable bound by the inferred type of f :: [a] -> b at T7869.hs:3:1-27 • In the expression: f x In the expression: (\ x -> f x) :: [a] -> b In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b - • Relevant bindings include f :: [a] -> b (bound at T7869.hs:3:1) + • Relevant bindings include + x :: [a1] (bound at T7869.hs:3:7) + f :: [a] -> b (bound at T7869.hs:3:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83047a104850ff77e076bc66e6127015dfdd5f00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83047a104850ff77e076bc66e6127015dfdd5f00 You're receiving 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 21 16:14:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 12:14:38 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 54 commits: docs: -B rts option sounds the bell on every GC (#18351) Message-ID: <5f68d16ee3032_80b3f8495b71bb0135044a4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 913c91c3 by Andreas Klebinger at 2020-09-21T09:23:59-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - 65916b0f by Ben Gamari at 2020-09-21T12:13:43-04:00 Bump Win32 submodule to 2.10.0.0 - - - - - ff84da6c by Ben Gamari at 2020-09-21T12:14:13-04:00 Bump bytestring submodule to 0.10.12.0 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20bc4ea42d446062f67b5777b87baa7da7c1e91c...ff84da6ce2369784ca17286f42446d445d816748 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20bc4ea42d446062f67b5777b87baa7da7c1e91c...ff84da6ce2369784ca17286f42446d445d816748 You're receiving 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 21 16:17:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 12:17:51 -0400 Subject: [Git][ghc/ghc][wip/backports] 6 commits: rts: Drop field initializer on thread_basic_info_data_t Message-ID: <5f68d22f5604_80b3f848acb0284135088bb@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 4ffa7d40 by Ben Gamari at 2020-09-18T08:31:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. (cherry picked from commit 09b91e8b95eb16fe72aef8405896fd6caf789f61) - - - - - e5f6188b by Zubin Duggal at 2020-09-18T08:32:37-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - d16223fd by Alan Zimmerman at 2020-09-18T08:38:16-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) (cherry picked from commit 701463ec9998c679b03dcc848912a7ce9da9a66a) - - - - - 23f34f7b by Alan Zimmerman at 2020-09-18T08:38:29-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features (cherry picked from commit 0f4d29cac3826392ceb26ea219fce6e8a7505107) - - - - - 37c65f13 by Ben Gamari at 2020-09-21T09:37:03-04:00 Bump Win32 submodule - - - - - 83201c2a by Ben Gamari at 2020-09-21T12:12:28-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. (cherry picked from commit a89c2fbab9bcf7d769e9d27262ab29f93342f114) - - - - - 8 changed files: - .gitlab/ci.sh - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - libraries/Win32 - rts/posix/GetTime.c - testsuite/tests/ghc-api/annotations/Makefile - testsuite/tests/ghc-api/annotations/T10358.stdout Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,6 +8,9 @@ set -e -o pipefail # Configuration: hackage_index_state="@1579718451" +MIN_HAPPY_VERSION="1.19" +MIN_ALEX_VERSION="3.2" + # Colors BLACK="0;30" GRAY="1;30" @@ -168,6 +171,7 @@ function set_toolchain_paths() { HAPPY="$HOME/.cabal/bin/happy" ALEX="$HOME/.cabal/bin/alex" fi + export GHC export CABAL export HAPPY @@ -286,17 +290,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() { ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Driver.Types import GHC.Unit.Module ( ModuleName, ml_hs_file ) import GHC.Utils.Monad ( concatMapM, liftIO ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique ) +import GHC.Types.Name ( Name, nameSrcSpan, nameUnique ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) @@ -52,7 +52,7 @@ import GHC.Core.InstEnv import GHC.Builtin.Types ( mkListTy, mkSumTy ) import GHC.Tc.Types import GHC.Tc.Types.Evidence -import GHC.Types.Var ( Id, Var, EvId, setVarName, varName, varType, varUnique ) +import GHC.Types.Var ( Id, Var, EvId, varName, setVarName, varType, varUnique ) import GHC.Types.Var.Env import GHC.Types.Unique import GHC.Iface.Make ( mkIfaceExports ) @@ -1274,26 +1274,22 @@ instance ( ToHie (RFContext (Located label)) , toHie expr ] -removeDefSrcSpan :: Name -> Name -removeDefSrcSpan n = setNameLoc n noSrcSpan - instance ToHie (RFContext (LFieldOcc GhcRn)) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name) + [ toHie $ C (RecField c rhs) (L nspan name) ] instance ToHie (RFContext (LFieldOcc GhcTc)) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous name _ -> - [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name + [ toHie $ C (RecField c rhs) $ L nspan name ] Ambiguous _name _ -> [ ] @@ -1301,13 +1297,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] Ambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM ===================================== compiler/GHC/Parser.y ===================================== @@ -1961,7 +1961,7 @@ type :: { LHsType GhcPs } | btype '#->' ctype {% hintLinear (getLoc $2) >> ams (sLL $1 $> $ HsFunTy noExtField HsLinearArrow $1 $3) - [mu AnnRarrow $2] } + [mu AnnLolly $2] } mult :: { LHsType GhcPs } : btype { $1 } @@ -2080,10 +2080,10 @@ tv_bndrs :: { [LHsTyVarBndr Specificity GhcPs] } tv_bndr :: { LHsTyVarBndr Specificity GhcPs } : tv_bndr_no_braces { $1 } | '{' tyvar '}' {% ams (sLL $1 $> (UserTyVar noExtField InferredSpec $2)) - [mop $1, mcp $3] } + [moc $1, mcc $3] } | '{' tyvar '::' kind '}' {% ams (sLL $1 $> (KindedTyVar noExtField InferredSpec $2 $4)) - [mop $1,mu AnnDcolon $3 - ,mcp $5] } + [moc $1,mu AnnDcolon $3 + ,mcc $5] } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } : tyvar { sL1 $1 (UserTyVar noExtField SpecifiedSpec $1) } @@ -3717,6 +3717,7 @@ isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITlolly iu)) = iu == UnicodeSyntax isUnicode _ = False hasE :: Located Token -> Bool ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1231,13 +1231,14 @@ makeFunBind fn ms checkPatBind :: LPat GhcPs -> Located (a,GRHSs GhcPs (LHsExpr GhcPs)) -> P ([AddAnn],HsBind GhcPs) -checkPatBind lhs (L match_span (_,grhss)) +checkPatBind lhs (L rhs_span (_,grhss)) | BangPat _ p <- unLoc lhs , VarPat _ v <- unLoc p = return ([], makeFunBind v [L match_span (m v)]) where + match_span = combineSrcSpans (getLoc lhs) rhs_span m v = Match { m_ext = noExtField - , m_ctxt = FunRhs { mc_fun = L (getLoc lhs) (unLoc v) + , m_ctxt = FunRhs { mc_fun = v , mc_fixity = Prefix , mc_strictness = SrcStrict } , m_pats = [] ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit ca5fbc12851b98a52f96a43ea19c54c9ecf0f9e3 +Subproject commit d68374423fa3d3edd6b776e412e4093cc69b5f64 ===================================== rts/posix/GetTime.c ===================================== @@ -71,7 +71,7 @@ Time getCurrentThreadCPUTime(void) // support clock_getcpuclockid. Hence we prefer to use the Darwin-specific // path on Darwin, even if clock_gettime is available. #if defined(darwin_HOST_OS) - thread_basic_info_data_t info = { 0 }; + thread_basic_info_data_t info = { }; mach_msg_type_number_t info_count = THREAD_BASIC_INFO_COUNT; kern_return_t kern_err = thread_info(mach_thread_self(), THREAD_BASIC_INFO, (thread_info_t) &info, &info_count); ===================================== testsuite/tests/ghc-api/annotations/Makefile ===================================== @@ -39,7 +39,8 @@ listcomps: .PHONY: T10358 T10358: - $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs + # Ignore result code, we have an unattached (superfluous) AnnBang + - $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10358.hs .PHONY: T10396 T10396: ===================================== testsuite/tests/ghc-api/annotations/T10358.stdout ===================================== @@ -1,5 +1,5 @@ ---Unattached Annotation Problems (should be empty list)--- -[] +[(AnnBang, Test10358.hs:5:19)] ---Ann before enclosing span problem (should be empty list)--- [ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7080f074481ed27cc58399754a0eb9360945f0a3...83201c2af667436cdaab31618f106c36fb277225 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7080f074481ed27cc58399754a0eb9360945f0a3...83201c2af667436cdaab31618f106c36fb277225 You're receiving 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 21 19:23:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 15:23:13 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump submodules Message-ID: <5f68fda17d612_80b3f848704994413570316@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 41534efc by Ben Gamari at 2020-09-21T15:22:59-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 3 changed files: - libraries/Cabal - libraries/Win32 - libraries/bytestring Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb +Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit f059037820ce68c5f524b188496cab196d979950 +Subproject commit d68374423fa3d3edd6b776e412e4093cc69b5f64 ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit e043aacfc4202a59ccae8b8c8cf0e1ad83a3f209 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41534efcf6e8ae8f6e19e1c6f0b831bc92dc3011 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/41534efcf6e8ae8f6e19e1c6f0b831bc92dc3011 You're receiving 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 21 19:26:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 15:26:21 -0400 Subject: [Git][ghc/ghc][wip/backports] ci.sh: Enforce minimum happy/alex versions Message-ID: <5f68fe5dca306_80b3f848a2ea44813570875@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 5c4cf79e by Ben Gamari at 2020-09-21T15:26:11-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. (cherry picked from commit a89c2fbab9bcf7d769e9d27262ab29f93342f114) Modified to use happy-1.19 - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,6 +8,8 @@ set -e -o pipefail # Configuration: hackage_index_state="@1579718451" +MIN_ALEX_VERSION="3.2" + # Colors BLACK="0;30" GRAY="1;30" @@ -168,6 +170,7 @@ function set_toolchain_paths() { HAPPY="$HOME/.cabal/bin/happy" ALEX="$HOME/.cabal/bin/alex" fi + export GHC export CABAL export HAPPY @@ -286,17 +289,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==1.19.*" + + 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/5c4cf79e78eba57cbcc461d76d3397399d22a74d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c4cf79e78eba57cbcc461d76d3397399d22a74d You're receiving 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 21 19:27:26 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 21 Sep 2020 15:27:26 -0400 Subject: [Git][ghc/ghc][wip/backports] 3 commits: API Annotations: Fix annotation for strictness Message-ID: <5f68fe9e4ac50_80b3f8490d17d4813572388@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: f91ea170 by Alan Zimmerman at 2020-09-20T19:25:22+01:00 API Annotations: Fix annotation for strictness This adds the correct location for a ! or ~. It is a reconstruction of 3ccc80ee6120db7ead579c6e9fc5c2164f3bf575, some of which got mangled in the backport process. - - - - - fbdc93e7 by Ben Gamari at 2020-09-21T15:27:17-04:00 Bump Win32 submodule - - - - - 17740c20 by Ben Gamari at 2020-09-21T15:27:17-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. (cherry picked from commit a89c2fbab9bcf7d769e9d27262ab29f93342f114) Modified to use happy-1.19 - - - - - 3 changed files: - .gitlab/ci.sh - compiler/GHC/Parser/PostProcess.hs - libraries/Win32 Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,6 +8,8 @@ set -e -o pipefail # Configuration: hackage_index_state="@1579718451" +MIN_ALEX_VERSION="3.2" + # Colors BLACK="0;30" GRAY="1;30" @@ -168,6 +170,7 @@ function set_toolchain_paths() { HAPPY="$HOME/.cabal/bin/happy" ALEX="$HOME/.cabal/bin/alex" fi + export GHC export CABAL export HAPPY @@ -286,17 +289,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==1.19.*" + + info "Building alex..." + $cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION" } function cleanup_submodules() { ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1374,19 +1374,24 @@ pBangTy lt@(L l1 _) xs = Nothing -> (False, lt, pure (), xs) Just (l2, anns, prag, unpk, xs') -> let bl = combineSrcSpans l1 l2 - bt = addUnpackedness (prag, unpk) lt - in (True, L bl bt, addAnnsAt bl anns, xs') + (anns2, bt) = addUnpackedness (prag, unpk) lt + in (True, L bl bt, addAnnsAt bl (anns ++ anns2), xs') mkBangTy :: SrcStrictness -> LHsType GhcPs -> HsType GhcPs mkBangTy strictness = HsBangTy noExtField (HsSrcBang NoSourceText NoSrcUnpack strictness) -addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> HsType GhcPs -addUnpackedness (prag, unpk) (L _ (HsBangTy x bang t)) +addUnpackedness :: (SourceText, SrcUnpackedness) -> LHsType GhcPs -> ([AddAnn], HsType GhcPs) +addUnpackedness (prag, unpk) (L l (HsBangTy x bang t)) | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang - = HsBangTy x (HsSrcBang prag unpk strictness) t + = let + anns = case strictness of + SrcLazy -> [AddAnn AnnTilde (srcSpanFirstCharacter l)] + SrcStrict -> [AddAnn AnnBang (srcSpanFirstCharacter l)] + NoSrcStrict -> [] + in (anns, HsBangTy x (HsSrcBang prag unpk strictness) t) addUnpackedness (prag, unpk) t - = HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t + = ([], HsBangTy noExtField (HsSrcBang prag unpk NoSrcStrict) t) -- | Merge a /reversed/ and /non-empty/ soup of operators and operands -- into a type. ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit ca5fbc12851b98a52f96a43ea19c54c9ecf0f9e3 +Subproject commit d68374423fa3d3edd6b776e412e4093cc69b5f64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c4cf79e78eba57cbcc461d76d3397399d22a74d...17740c20e4c8e78add9e425910ac6546ffaeba03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c4cf79e78eba57cbcc461d76d3397399d22a74d...17740c20e4c8e78add9e425910ac6546ffaeba03 You're receiving 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 21 19:58:36 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Mon, 21 Sep 2020 15:58:36 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 4 commits: Remove addition of findPtrCb and related changes Message-ID: <5f6905ec9ffd9_80b3f849583a6b813576491@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: e6b5bbb2 by David Eichmann at 2020-09-18T10:33:29+01:00 Remove addition of findPtrCb and related changes - - - - - fba0e4d8 by David Eichmann at 2020-09-18T14:23:11+01:00 Rename rts_unpause to rts_resume - - - - - 9d010ebc by David Eichmann at 2020-09-21T20:36:40+01:00 Simplify and speedup test - - - - - 1762210f by David Eichmann at 2020-09-21T20:57:00+01:00 WIP Clarify multi-threaded behavior and correct usage of the ghc-debug API - - - - - 18 changed files: - includes/RtsAPI.h - − includes/rts/PrinterAPI.h - libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c - rts/Printer.c - rts/Printer.h - rts/RtsAPI.c - testsuite/tests/rts/ghc-debug/all.T - + testsuite/tests/rts/ghc-debug/ghc_debug.c - + testsuite/tests/rts/ghc-debug/ghc_debug.h - + testsuite/tests/rts/ghc-debug/ghc_debug_01.hs - + testsuite/tests/rts/ghc-debug/ghc_debug_02.hs - + testsuite/tests/rts/ghc-debug/ghc_debug_03.hs - − testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs - − testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c - − testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h - testsuite/tests/rts/ghc-debug/shouldfail/all.T - testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs - + testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.stderr Changes: ===================================== includes/RtsAPI.h ===================================== @@ -485,36 +485,23 @@ void rts_checkSchedStatus (char* site, Capability *); SchedulerStatus rts_getSchedStatus (Capability *cap); -// Various bits of information that need to be persisted between rts_pause and -// rts_unpause. -typedef struct RtsPaused_ { - // The task (i.e. OS thread) on which rts_pause() was called. This is used - // in rts_unpause() to check that it is called on the same OS thread. - Task *pausing_task; - - // The capability owned by pausing_task (possibly NULL) just before calling - // rts_unpause(). On rts_unpause(), the pausing_task will retain ownership - // of this capability (if not NULL). - Capability *capability; -} RtsPaused; - -// Halt execution of all Haskell threads by acquiring all capabilities. It is -// different to rts_lock() because rts_pause() pauses all capabilities while -// rts_lock() only pauses a single capability. rts_pause() and rts_unpause() -// have to be executed from the same OS thread (i.e. myTask() must stay the -// same). Returns the currently owned capability (possibly NULL). This must be -// passed back to rts_unpause(). -RtsPaused rts_pause (void); - -// Counterpart of rts_pause: Continue from a pause. -// rts_pause() and rts_unpause() have to be executed from the same OS thread -// (i.e. myTask() must stay the same). -void rts_unpause (RtsPaused); - -// Tells the current state of the RTS regarding rts_pause() and rts_unpause(). +// Halt execution of all Haskell threads (OS threads may continue) by acquiring +// all capabilities. Blocks untill pausing is completed. This is different to +// rts_lock() because rts_pause() pauses all capabilities while rts_lock() only +// pauses a single capability. rts_pause() and rts_resume() must be executed +// from the same OS thread. Must not be called when the rts is already paused. +void rts_pause (void); + +// Counterpart of rts_pause: Continue from a pause. All capabilities are +// released. Must be done while RTS is paused and on the same thread as +// rts_pause(). +void rts_resume (void); + +// Tells the current state of the RTS regarding rts_pause() and rts_resume(). bool rts_isPaused(void); -// List all live threads. Must be done while RTS is paused (see rts_pause()). +// List all live threads. Must be done while RTS is paused and on the same +// thread as rts_pause(). typedef void (*ListThreadsCb)(void *user, StgTSO *); void rts_listThreads(ListThreadsCb cb, void *user); ===================================== includes/rts/PrinterAPI.h deleted ===================================== @@ -1,23 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (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); ===================================== libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c ===================================== @@ -26,7 +26,7 @@ void* listThreads_thread(void* unused){ RtsPaused paused = rts_pause(); rts_listThreads(&collectTSOsCallback, NULL); rts_listMiscRoots(&collectMiscRootsCallback, NULL); - rts_unpause(paused); + rts_resume(paused); return NULL; } ===================================== rts/Printer.c ===================================== @@ -852,69 +852,37 @@ extern void DEBUG_LoadSymbols( const char *name STG_UNUSED ) #endif /* USING_LIBBFD */ -static void -findPtr_default_callback(void *user STG_UNUSED, StgClosure * closure){ - debugBelch("%p = ", closure); - printClosure((StgClosure *)closure); -} - +void findPtr(P_ p, int); /* keep gcc -Wall happy */ int searched = 0; -// Search through a block (and it's linked blocks) for closures that reference -// p. The size of arr is respected and the search is stoped when arr is full. -// TODO: This may produce false positives if e.g. a closure contains an Int that -// happens to have the same value as memory address p. Returns the new i value -// i.e. the next free position in the arr array. static int -findPtrBlocks - ( FindPtrCb cb // [in] callback called whenever a closure referencing p is found. - , void* user // [in] unused other than to pass to the callback. - , StgPtr p // [in] The pointer to search for. - , bdescr *bd // [in] The block descriptor of the block from which to start searching. - , StgPtr arr[] // [in/out] All found closure addresses are written into this array. - , int arr_size // [in] The size of arr. - , int i // [in] The current position in arr. - ) +findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i) { - StgPtr candidate, retainer, end; - - // Iterate over all blocks. + StgPtr q, r, end; for (; bd; bd = bd->link) { searched++; - // Scan the block looking for a pointer equal to p. - for (candidate = bd->start; candidate < bd->free; candidate++) { - if (UNTAG_CONST_CLOSURE((StgClosure*)*candidate) == (const StgClosure *)p) { - // *candidate looks like a pointer equal to p, but it might not - // be a pointer type i.e. it may just be an Int that happens to - // have the same value as memory address p. - - // We stop if the output array is full. + for (q = bd->start; q < bd->free; q++) { + if (UNTAG_CONST_CLOSURE((StgClosure*)*q) == (const StgClosure *)p) { if (i < arr_size) { - for (retainer = bd->start; retainer < bd->free; retainer = end) { + for (r = bd->start; r < bd->free; r = end) { // skip over zeroed-out slop - while (*retainer == 0) retainer++; - - // A quick check that retainer looks like a InfoTable pointer. - if (!LOOKS_LIKE_CLOSURE_PTR(retainer)) { + while (*r == 0) r++; + if (!LOOKS_LIKE_CLOSURE_PTR(r)) { debugBelch("%p found at %p, no closure at %p\n", - p, candidate, retainer); + p, q, r); break; } - end = retainer + closure_sizeW((StgClosure*)retainer); - if (candidate < end) { - // end has just increased past candidate. Hence - // candidate is in the closure starting at retainer. - cb(user, (StgClosure *) retainer); - arr[i++] = retainer; + end = r + closure_sizeW((StgClosure*)r); + if (q < end) { + debugBelch("%p = ", r); + printClosure((StgClosure *)r); + arr[i++] = r; break; } } - if (retainer >= bd->free) { - // TODO: How is this case reachable? Perhaps another - // thread overwrote *q after we found q and before we - // found the corresponding closure retainer. - debugBelch("%p found at %p, closure?", p, candidate); + if (r >= bd->free) { + debugBelch("%p found at %p, closure?", p, q); } } else { return i; @@ -925,19 +893,8 @@ findPtrBlocks return i; } -// Search for for closures that reference p. This may NOT find all such closures -// (e.g. the nursery is not searched). This may also find false positives if -// e.g. a closure contains an Int that happens to have the same value as memory -// address p. The number of results is capped at 1024. The callback is called -// for each closure found. -static void -findPtr_gen - ( FindPtrCb cb // [in] Callback called for each closure found referencing p. - , void *user // [in] Unused other than to pass to the callback. - , P_ p // [in] Search for closures referencing this address. - , int follow // [in] If set to 1 and only a single closure was found, - // recursively find pointers to that if to recurse (call findPtr on the ). May only be 1 if cb==findPtr_default_callback. - ) +void +findPtr(P_ p, int follow) { uint32_t g, n; bdescr *bd; @@ -959,38 +916,24 @@ findPtr_gen for (g = 0; g < RtsFlags.GcFlags.generations; g++) { bd = generations[g].blocks; - i = findPtrBlocks(cb, user,p,bd,arr,arr_size,i); + i = findPtrBlocks(p,bd,arr,arr_size,i); bd = generations[g].large_objects; - i = findPtrBlocks(cb, user, p,bd,arr,arr_size,i); + i = findPtrBlocks(p,bd,arr,arr_size,i); if (i >= arr_size) return; for (n = 0; n < n_capabilities; n++) { - i = findPtrBlocks(cb, user, p, gc_threads[n]->gens[g].part_list, + i = findPtrBlocks(p, gc_threads[n]->gens[g].part_list, arr, arr_size, i); - i = findPtrBlocks(cb, user, p, gc_threads[n]->gens[g].todo_bd, + i = findPtrBlocks(p, gc_threads[n]->gens[g].todo_bd, arr, arr_size, i); } if (i >= arr_size) return; } if (follow && i == 1) { - ASSERT(cb == &findPtr_default_callback); debugBelch("-->\n"); - // Non-standard callback expects follow=0 findPtr(arr[0], 1); } } -// Special case of findPtrCb: Uses a default callback, that prints the closure -// pointed to by p. -void findPtr(P_ p, int follow){ - findPtr_gen(&findPtr_default_callback, NULL, p, follow); -} - -// Call cb on the closure pointed to by p. -// FindPtrCb is documented where it's defined. -void findPtrCb(FindPtrCb cb, void* user, P_ p){ - findPtr_gen(cb, user, p, 0); -} - const char *what_next_strs[] = { [0] = "(unknown)", [ThreadRunGHC] = "ThreadRunGHC", ===================================== rts/Printer.h ===================================== @@ -10,8 +10,6 @@ #include "BeginPrivate.h" -#include "rts/PrinterAPI.h" - extern void printPtr ( StgPtr p ); extern void printObj ( StgClosure *obj ); ===================================== rts/RtsAPI.c ===================================== @@ -647,63 +647,173 @@ rts_unlock (Capability *cap) } #if defined(THREADED_RTS) -static bool rts_paused = false; +// The task that paused the RTS. The rts_pausing_task variable is owned by the +// task that owns all capabilities (there is at most one such task). +Task * rts_pausing_task = NULL; // See RtsAPI.h -RtsPaused rts_pause (void) -{ - if (rts_isPaused()) +void rts_pause (void) +{ + // The current task must not own a capability. This is true when a new + // thread is stareted, or when making a safe FFI call. If + // `task->cap->running_task == task` then that is also ok because the + // capability can be taken by other capabilities. Note that we always check + // (rather than ASSERT which only happens with `-debug`) because this is a + // user facing function and we want good error reporting. We also don't + // expect rts_pause to be performance critical. + Task * task = getMyTask(); + if (task->cap && task->cap->running_task == task) { - errorBelch("error: rts_pause: attempting to pause an already paused RTS."); + // This task owns a capability (at it can't be taken by other capabilities). + errorBelch(task->cap->in_haskell + ? ("error: rts_pause: attempting to pause via an unsafe FFI call.\n" + " Perhaps a 'foreign import unsafe' should be 'safe'?") + : ("error: rts_pause: attempting to pause from a Task that owns a capability.\n" + " Have you already acquired a capability e.g. with rts_lock?")); stg_exit(EXIT_FAILURE); } - RtsPaused rtsPaused; - rtsPaused.pausing_task = newBoundTask(); - - // Check if we own a capability. This is needed to correctly call - // stopAllCapabilities() and to know if to keep ownership or release the - // capability on rts_unpause(). - Capability * cap = rtsPaused.pausing_task->cap; - bool taskOwnsCap = cap != NULL && cap->running_task == rtsPaused.pausing_task; - rtsPaused.capability = taskOwnsCap ? cap : NULL; - stopAllCapabilities(taskOwnsCap ? &rtsPaused.capability : NULL, rtsPaused.pausing_task); + // Note that if the rts was paused by another task/thread, then we block + // instead of error. It's only an error if the same thread tries to pause + // twice in a row. + if (rts_pausing_task == task) + { + errorBelch("error: rts_pause: attempting to pause an already paused RTS."); + stg_exit(EXIT_FAILURE); + } - rts_paused = true; - return rtsPaused; + // NOTE ghc-debug deadlock: + // + // stopAllCapabilities attempts to acquire all capabilities and will only + // block if an existing thread/task: + // + // 1. Owns a capability and + // 2. Is deadlocked i.e. refuses to yield/release its capability. + // + // Let's assume the rest of the RTS is deadlock free (tasks will eventually + // yield their capability) outside of using the ghc-debug API: + // + // * rts_pause + // * rts_resume + // * rts_isPaused + // * rts_listThreads + // * rts_listMiscRoots + // + // Except rts_pause, none of these functions acquire a lock and so cannot + // block. rts_pause may block on stopAllCapabilities, but we ensure that the + // current task does not own a capability before calling + // stopAllCapabilities. Hence, (1) does not hold given an isolated call to + // rts_pause. The only lose end is that after rts_pause, we now have a task + // that (by design) owns all capabilities (point (1) above) and is refusing + // to yield them (point (2) above). Indeed, if 2 threads concurrently call + // rts_pause, one will block until the other calls rts_resume. As "correct + // usage" of this API requires calling rts_resume, this case is a non-issue, + // but does imply the awkward quirk that if you call rts_pause on many + // threads, they will all "take turns" pausing the rts, blocking until it is + // their turn. In adition, any API function that attempts to acquire a + // capability (e.g. rts_lock), will block until rts_resume is called. Of + // course, all ghc-debug API functions besides rts_pause do not attempt to + // acquire a capability. + // + // The moral to this story is that you will not dealock as long as you, on + // the same thread: + // + // * First call rts_pause + // * Then avoid rts functions other than: + // * rts_isPaused + // * rts_listThreads + // * rts_listMiscRoots + // * AND dereferencing/inspect the heap directly e.g. using + // rts_listThreads/rts_listMiscRoots and the ghc-heap library. + // * Finally call rts_resume + // + // TODO + // + // I think we should return Capability*. We should be able to use the rest + // of the rts API with that token. There are a few functions that take + // `Capability **` implying that it may change capabilities. I need to + // confirm, but I think that in our case, we'll just end up with the same + // capability since all others are acquired already. These other API + // functions may change the heap, but it is up to the caller to account for + // that. Is it possible that the API can be used to start executing a + // haskell thread?!?!?! That's perhaps ok as long as we reacquire the + // capability at the end so we're paused. + task = newBoundTask(); // TODO I'm not sure why we need this. rts_lock does this. + stopAllCapabilities(NULL, task); + + // Now we own all capabilities so we own rts_pausing_task. + rts_pausing_task = task; } // See RtsAPI.h -void rts_unpause (RtsPaused rtsPaused) +void rts_resume (void) { - if (!rts_isPaused()) + Task * task = getMyTask(); // This thread has ownership over its Task. + + if (task != rts_pausing_task) { - errorBelch("error: rts_pause: attempting to resume an RTS that is not paused."); + // We don't have a lock on rts_pausing_task but we are garanteed that + // rts_pausing_task won't be set the current task (because the current + // task is here now!), so the error messages are still correct. + errorBelch (rts_isPaused() + ? "error: rts_resume: called from a different OS thread than rts_pause." + : "error: rts_resume: the rts is not paused. Did you forget to call rts_pause?"); + stg_exit(EXIT_FAILURE); } - if (rtsPaused.pausing_task != getMyTask()) + + // Check that we own all capabilities. + for (uint i = 0; i < n_capabilities; i++) { - errorBelch("error: rts_unpause was called from a different OS thread than rts_pause."); - stg_exit(EXIT_FAILURE); + Capability *cap = capabilities[i]; + if (cap->running_task != task) + { + errorBelch ("error: rts_resume: the pausing thread does not own all capabilities." + " Have you manually released a capability after calling rts_pause?"); + stg_exit(EXIT_FAILURE); + } } - rts_paused = false; - releaseAllCapabilities(n_capabilities, rtsPaused.capability, getMyTask()); + // Now we own all capabilities so we own rts_pausing_task. + rts_pausing_task = NULL; + + // releaseAllCapabilities will not block because the current task owns all + // capabilities. + releaseAllCapabilities(n_capabilities, NULL, task); exitMyTask(); } // See RtsAPI.h bool rts_isPaused(void) { - return rts_paused; + return rts_pausing_task != NULL; } -// Call cb for all StgTSOs. *user is a user defined payload to cb. It's not -// used by the RTS. -// rts_listThreads should only be called when the RTS is paused, i.e. rts_pause -// was called before. +// Check that the rts_pause was called on this thread/task. If not, outputs an +// error and exits with EXIT_FAILURE. +void assert_isPausedOnMyTask(void) +{ + if (rts_pausing_task == NULL) + { + errorBelch ("error: rts_listThreads: the rts is not paused. Did you forget to call rts_pause?"); + stg_exit(EXIT_FAILURE); + } + else if (rts_pausing_task != myTask()) + { + errorBelch ("error: rts_listThreads: must be called from the same thread as rts_pause."); + stg_exit(EXIT_FAILURE); + } +} + +// See RtsAPI.h void rts_listThreads(ListThreadsCb cb, void *user) { + assert_isPausedOnMyTask(); + + // rts_pausing_task == myTask(). This implies that the rts is paused and can + // only be resumed by the current thread. Hence it is safe to read global + // thread data. + for (uint32_t g=0; g < RtsFlags.GcFlags.generations; g++) { StgTSO *tso = generations[g].threads; while (tso != END_TSO_QUEUE) { @@ -724,13 +834,11 @@ static void list_roots_helper(void *user, StgClosure **p) { ctx->cb(ctx->user, *p); } -// Call cb for all StgClosures reachable from threadStableNameTable and -// threadStablePtrTable. *user is a user defined payload to cb. It's not -// used by the RTS. -// rts_listMiscRoots should only be called when the RTS is paused, i.e. -// rts_pause was called before. +// See RtsAPI.h void rts_listMiscRoots (ListRootsCb cb, void *user) { + assert_isPausedOnMyTask(); + struct list_roots_ctx ctx; ctx.cb = cb; ctx.user = user; @@ -740,21 +848,18 @@ void rts_listMiscRoots (ListRootsCb cb, void *user) } #else -RtsPaused rts_pause (void) +void rts_pause (void) { errorBelch("Warning: Pausing the RTS is only possible for " "multithreaded RTS."); - RtsPaused rtsPaused = { - .pausing_task = NULL, - .capability = NULL - }; - return rtsPaused; + stg_exit(EXIT_FAILURE); } -void rts_unpause (RtsPaused cap STG_UNUSED) +void rts_resume (void) { errorBelch("Warning: Unpausing the RTS is only possible for " "multithreaded RTS."); + stg_exit(EXIT_FAILURE); } bool rts_isPaused() ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,6 +1,18 @@ -test('rts_pause_and_unpause', - [ extra_files(['rts_pause_and_unpause_c.c','rts_pause_and_unpause_c.h']), +test('ghc_debug_01', + [ extra_files(['ghc_debug.c','ghc_debug.h']), ignore_stdout, ignore_stderr ], - multi_compile_and_run, ['rts_pause_and_unpause', [('rts_pause_and_unpause_c.c','')], '-threaded ']) \ No newline at end of file + multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '-threaded ']) +test('ghc_debug_02', + [ extra_files(['ghc_debug.c','ghc_debug.h']), + ignore_stdout, + ignore_stderr + ], + multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '-threaded ']) +test('ghc_debug_03', + [ extra_files(['ghc_debug.c','ghc_debug.h']), + ignore_stdout, + ignore_stderr + ], + multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '-threaded ']) ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.c ===================================== @@ -0,0 +1,120 @@ +#include +#include + +#include "Rts.h" +#include "RtsAPI.h" + +#include "ghc_debug.h" + +void expectNoChange(const char * msg, volatile unsigned int * count); +void expectChange(const char * msg, volatile unsigned int * count); + +// Test rts_pause/rts_resume by observing a count that we expect to be +// incremented by concurrent Haskell thread(s). We expect rts_pause to stop +// those threads and hence stop incrementing the count. +void pauseAndResume + ( bool assertNotPaused // [in] True to enable assertions before rts_pause and after rts_resume. + // Often disabled when calling this concurrently. + , volatile unsigned int * count // [in] Haskell threads should be forever incrementing this. + ) +{ + // Assert the RTS is resumed. + if (assertNotPaused) + { + expectChange("RTS should be running", count); + if(rts_isPaused()) { + errorBelch("Expected the RTS to be resumed."); + exit(1); + } + } + + // Pause and assert. + rts_pause(); + if(!rts_isPaused()) { + errorBelch("Expected the RTS to be paused."); + exit(1); + } + + expectNoChange("RTS should be paused", count); + + // Resume. + rts_resume(); + + // Assert the RTS is resumed. + if (assertNotPaused) + { + expectChange("RTS should be resumed", count); + if(rts_isPaused()) { + errorBelch("Expected the RTS to be resumed."); + exit(1); + } + } +} + +void* pauseAndResumeViaThread_helper(volatile unsigned int * count) +{ + pauseAndResume(false, count); + return NULL; +} + +// Call pauseAndResume via a new thread and return the thread ID. +unsigned long pauseAndResumeViaThread + ( volatile unsigned int * count // [in] Haskell threads should be forever incrementing this. + ) +{ + pthread_t threadId; + pthread_create(&threadId, NULL, &pauseAndResumeViaThread_helper, count); + return threadId; +} + +const int TIMEOUT = 1000000; // 1 second + +// Wait for &count to change (else exit(1) after TIMEOUT). +void expectChange(const char * msg, volatile unsigned int * count) +{ + unsigned int count_0 = *count; + int microSecondsLeft = TIMEOUT; + unsigned int sleepTime = 10000; + while (true) + { + usleep(sleepTime); + microSecondsLeft -= sleepTime; + + if (count_0 != *count) + { + // Change detected. + return; + } + + if (microSecondsLeft < 0) + { + printf("Expected: %s\n", msg); + exit(1); + } + } +} + +// Ensure &count does NOT change (for TIMEOUT else exit(1)). +void expectNoChange(const char * msg, volatile unsigned int * count) +{ + unsigned int count_0 = *count; + int microSecondsLeft = TIMEOUT; + unsigned int sleepTime = 10000; + while (true) + { + usleep(sleepTime); + microSecondsLeft -= sleepTime; + + if (count_0 != *count) + { + // Change detected. + printf("Expected: %s\n", msg); + exit(1); + } + + if (microSecondsLeft < 0) + { + return; + } + } +} ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.h ===================================== @@ -0,0 +1,3 @@ + +void pauseAndResume(bool assertNotPaused, volatile unsigned int * count); +unsigned long pauseAndResumeViaThread(volatile unsigned int * count); ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_01.hs ===================================== @@ -0,0 +1,38 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Monad +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import GHC.Stack + +foreign import ccall safe "ghc_debug.h pauseAndResume" + safe_pauseAndResume_c :: CBool -> Ptr CUInt -> IO () + +-- Simple test of rts_pause() followed by rts_resume() +main :: IO () +main = do + alloca $ \countPtr -> do + poke countPtr 0 + + -- forever increment count. Changes will be observed from the c code. + sequence_ $ replicate 4 $ forkIO $ forever $ do + count <- peek countPtr + poke countPtr (count + 1) + threadDelay 10000 -- 10 milliseconds + + -- Test rts_pause/rts_resume. + safe_pauseAndResume_c cTrue countPtr + + -- Test rts_pause/rts_resume from a unbound (worker) thread. + mvar <- newEmptyMVar + forkIO $ do + safe_pauseAndResume_c cTrue countPtr + putMVar mvar () + takeMVar mvar + +cTrue :: CBool +cTrue = 1 ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_02.hs ===================================== @@ -0,0 +1,38 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Monad +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable + +foreign import ccall safe "ghc_debug.h pauseAndResumeViaThread" + safe_pauseAndResumeViaThread_c :: Ptr CUInt -> IO CULong + +foreign import ccall safe "pthread.h pthread_join" + safe_pthread_join_c :: CULong -> IO () + +-- Simple test of rts_pause() followed by rts_resume() via a new thread created +-- in c code. +main :: IO () +main = do + alloca $ \countPtr -> do + poke countPtr 0 + + -- forever increment count. Changes will be observed from the c code. + sequence_ $ replicate 4 $ forkIO $ forever $ do + count <- peek countPtr + poke countPtr (count + 1) + threadDelay 10000 -- 10 milliseconds + + -- Test rts_pause/rts_resume. + safe_pthread_join_c =<< safe_pauseAndResumeViaThread_c countPtr + + -- Test rts_pause/rts_resume from a unbound (worker) thread. + mvar <- newEmptyMVar + forkIO $ do + safe_pthread_join_c =<< safe_pauseAndResumeViaThread_c countPtr + putMVar mvar () + takeMVar mvar ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_03.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Monad +import Foreign.C.Types +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import System.Exit +import System.Timeout + +foreign import ccall safe "ghc_debug.h pauseAndResume" + safe_pauseAndResume_c :: CBool -> Ptr CUInt -> IO () + +-- Test that concurrent calls to rts_pause()/rts_resume() doesn't cause deadlock. +main :: IO () +main = do + alloca $ \countPtr -> do + poke countPtr 0 + + -- forever increment count. Changes will be observed from the c code. + sequence_ $ replicate 4 $ forkIO $ forever $ do + count <- peek countPtr + poke countPtr (count + 1) + threadDelay 10000 -- 10 milliseconds + + -- Note that each call blocks for about a second, so this will take 5 + -- seconds to complete. + let n = 5 + mvars <- sequence $ replicate n newEmptyMVar + forM_ mvars $ \mvar -> forkIO $ do + safe_pauseAndResume_c + -- Don't check rts_isPaused() before rts_pause nore after rts_resume + -- because we're doing this concurrently so that would introduce a race + -- condition. + cFalse + countPtr + putMVar mvar () + + -- Wait (at least 2n seconds to be safe) for all threads to finish. + result <- timeout (2 * n * 1000000) (mapM_ takeMVar mvars) + case result of + Nothing -> do + putStrLn "Not all rts_pause/rts_resume threads have finished. Assuming deadlocked and failing test." + exitFailure + Just () -> do + putStrLn "All threads finished" + exitSuccess + +cFalse :: CBool +cFalse = 0 ===================================== testsuite/tests/rts/ghc-debug/rts_pause_and_unpause.hs deleted ===================================== @@ -1,98 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -import Data.Word -import Data.IORef -import GHC.Clock -import Control.Concurrent -import Foreign.C.Types -import System.Mem -import Control.Monad - -foreign import ccall safe "rts_pause_and_unpause_c.h pauseAndUnpause" - safe_pauseAndUnpause_c :: IO () - -foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpause" - unsafe_pauseAndUnpause_c :: IO () - -foreign import ccall unsafe "rts_pause_and_unpause_c.h pauseAndUnpauseViaNewThread" - unsafe_pauseAndUnpauseViaNewThread_c :: IO () - --- Note that these should be unsafe FFI calls. rts_pause() does not pause or --- wait for safe FFI calls, as they do not own a capability. -foreign import ccall unsafe "rts_pause_and_unpause_c.h getUnixTime" - getUnixTime_c :: IO CTime - -foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseBegin" - getPauseBegin_c :: IO CTime - -foreign import ccall unsafe "rts_pause_and_unpause_c.h getPauseEnd" - getPauseEnd_c :: IO CTime - -clockEachSecond :: IORef [CTime] -> IO () -clockEachSecond ref = forever $ do - time <- getUnixTime_c - modifyIORef ref $ (time:) - - sleepSeconds 1 - -{- To show that rts_pause() and rts_unpause() work, clockEachSecond adds the -current unix time to a list (once per Second). pauseAndUnpause_c stops the RTS -for 5 Seconds. Thus there's an invariant that there should be no timestamp in -the list that is in this 5 Seconds wide timeframe, which is defined by -getPauseBegin_c and getPauseEnd_c. -} -main :: IO () -main = do - -- Start thread that forever writes the current time to an IORef - ref <- newIORef [] - forkIO $ clockEachSecond ref - - -- Attempt pause and unpause in various forms - withPauseAndUnpause ref - "Pause and unpause via safe FFI call" - safe_pauseAndUnpause_c - - withPauseAndUnpause ref - "Pause and unpause via unsafe FFI call" - unsafe_pauseAndUnpause_c - - withPauseAndUnpause ref - "Pause and unpause via unsafe FFI call that creates a new OS thread" - unsafe_pauseAndUnpauseViaNewThread_c - -withPauseAndUnpause :: IORef [CTime] -> String -> IO () -> IO () -withPauseAndUnpause ref startMsg pauseAndUnpause = do - putStrLn startMsg - - writeIORef ref [] - sleepSeconds 3 - pauseAndUnpause - - -- This seems to sleep for 8 - 5 Seconds. That's strange, but should be - -- good enough for this test. - -- 5 Seconds is the time the whole RTS is paused. But I (Sven) don't - -- understand how this relates. - sleepSeconds 8 - - times <- readIORef ref - - pauseBegin <- getPauseBegin_c - pauseEnd <- getPauseEnd_c - filter (\t -> pauseBegin < t && t < pauseEnd) times `shouldBe` [] - filter (\t -> t <= pauseBegin) times `shouldNotBe` [] - filter (\t -> t >= pauseEnd) times `shouldNotBe` [] - - putStrLn "DONE" - -sleepSeconds :: Int -> IO () -sleepSeconds t = threadDelay $ oneSecondInMicroSeconds * t - -oneSecondInMicroSeconds :: Int -oneSecondInMicroSeconds = 1000000 - -shouldBe :: (Eq a, Show a) => a -> a -> IO () -shouldBe x y = - unless (x == y) $ fail $ show x ++ " is not equal to " ++ show y - -shouldNotBe :: (Eq a, Show a) => a -> a -> IO () -shouldNotBe x y = - unless (x /= y) $ fail $ show x ++ " is equal to " ++ show y ===================================== testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.c deleted ===================================== @@ -1,54 +0,0 @@ -#include -#include -#include -#include "rts_pause_and_unpause_c.h" -#include "Rts.h" -#include "RtsAPI.h" - -#include - -struct PauseTimestamps timestamps = {0, 0}; - -void* pauseAndUnpause_thread(void* unused){ - RtsPaused rtsPaused = rts_pause(); - - if(!rts_isPaused()) { - errorBelch("Expected the RTS to be paused."); - exit(1); - } - - timestamps.begin = time(NULL); - sleep(5); - timestamps.end = time(NULL); - - rts_unpause(rtsPaused); - - if(rts_isPaused()) { - errorBelch("Expected the RTS to be unpaused."); - exit(1); - } - - return NULL; -} - -void pauseAndUnpause(void){ - pauseAndUnpause_thread(NULL); -} - -void pauseAndUnpauseViaNewThread(void){ - pthread_t threadId; - pthread_create(&threadId, NULL, &pauseAndUnpause_thread, NULL); - pthread_detach(threadId); -} - -time_t getPauseBegin(void) { - return timestamps.begin; -} - -time_t getPauseEnd(void) { - return timestamps.end; -} - -time_t getUnixTime(void){ - return time(NULL); -} ===================================== testsuite/tests/rts/ghc-debug/rts_pause_and_unpause_c.h deleted ===================================== @@ -1,11 +0,0 @@ -#include - -struct PauseTimestamps{ - time_t begin; - time_t end; -}; - -void pauseAndUnpause(void); -time_t getPauseBegin(void); -time_t getPauseEnd(void); -time_t getUnixTime(void); ===================================== testsuite/tests/rts/ghc-debug/shouldfail/all.T ===================================== @@ -1 +1 @@ -test('unsafe_rts_pause', [ignore_stderr, exit_code(134)], compile_and_run, ['-threaded ']) \ No newline at end of file +test('unsafe_rts_pause', [exit_code(1)], compile_and_run, ['-threaded ']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs ===================================== @@ -15,7 +15,7 @@ foreign import ccall unsafe "RtsAPI.h rts_pause" main :: IO () main = do - putStrLn "Making a unsafe call to rts_pause() should fail on return. We \ + putStrLn "Making a unsafe call to rts_pause() should fail. We \ \cannot allow this haskell thread to continue if the RTS is paused." _ <- unsafe_rts_pause_c putStrLn "Oops! Haskell thread has continued even though RTS was paused." ===================================== testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.stderr ===================================== @@ -0,0 +1,2 @@ +unsafe_rts_pause: error: rts_pause: attempting to pause via an unsafe FFI call. + Perhaps a 'foreign import unsafe' should be 'safe'? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47b915a196db03d57ca3358a7c03e6ab97e7aac4...1762210f8b17de124dd2a20594eca75f97f4db9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47b915a196db03d57ca3358a7c03e6ab97e7aac4...1762210f8b17de124dd2a20594eca75f97f4db9b You're receiving 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 21 20:45:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 21 Sep 2020 16:45:56 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Remove unused ThBrackCtxt and ResSigCtxt Message-ID: <5f6911041805_80b107090941358687b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - 6 changed files: - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - + testsuite/tests/typecheck/should_fail/T18714.hs - + testsuite/tests/typecheck/should_fail/T18714.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2838,7 +2838,6 @@ expectedKindInCtxt :: UserTypeCtxt -> ContextKind -- Depending on the context, we might accept any kind (for instance, in a TH -- splice), or only certain kinds (like in type signatures). expectedKindInCtxt (TySynCtxt _) = AnyKind -expectedKindInCtxt ThBrackCtxt = AnyKind expectedKindInCtxt (GhciCtxt {}) = AnyKind -- The types in a 'default' decl can have varying kinds -- See Note [Extended defaults]" in GHC.Tc.Utils.Env ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -84,15 +84,12 @@ data UserTypeCtxt -- or (x::t, y) = e | RuleSigCtxt Name -- LHS of a RULE forall -- RULE "foo" forall (x :: a -> a). f (Just x) = ... - | ResSigCtxt -- Result type sig - -- f x :: t = .... | ForSigCtxt Name -- Foreign import or export signature | DefaultDeclCtxt -- Types in a default declaration | InstDeclCtxt Bool -- An instance declaration -- True: stand-alone deriving -- False: vanilla instance declaration | SpecInstCtxt -- SPECIALISE instance pragma - | ThBrackCtxt -- Template Haskell type brackets [t| ... |] | GenSigCtxt -- Higher-rank or impredicative situations -- e.g. (f e) where f has a higher-rank type -- We might want to elaborate this @@ -136,9 +133,7 @@ pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature fo pprUserTypeCtxt TypeAppCtxt = text "a type argument" pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c) -pprUserTypeCtxt ThBrackCtxt = text "a Template Haskell quotation [t|...|]" pprUserTypeCtxt PatSigCtxt = text "a pattern type signature" -pprUserTypeCtxt ResSigCtxt = text "a result type signature" pprUserTypeCtxt (ForSigCtxt n) = text "the foreign declaration for" <+> quotes (ppr n) pprUserTypeCtxt DefaultDeclCtxt = text "a type in a `default' declaration" pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration" ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -348,7 +348,6 @@ checkValidType ctxt ty rank = case ctxt of DefaultDeclCtxt-> MustBeMonoType - ResSigCtxt -> MustBeMonoType PatSigCtxt -> rank0 RuleSigCtxt _ -> rank1 TySynCtxt _ -> rank0 @@ -372,7 +371,6 @@ checkValidType ctxt ty ForSigCtxt _ -> rank1 SpecInstCtxt -> rank1 - ThBrackCtxt -> rank1 GhciCtxt {} -> ArbitraryRank TyVarBndrKindCtxt _ -> rank0 @@ -472,18 +470,81 @@ forAllAllowed ArbitraryRank = True forAllAllowed (LimitedRank forall_ok _) = forall_ok forAllAllowed _ = False +-- | Indicates whether a 'UserTypeCtxt' represents type-level contexts, +-- kind-level contexts, or both. +data TypeOrKindCtxt + = OnlyTypeCtxt + -- ^ A 'UserTypeCtxt' that only represents type-level positions. + | OnlyKindCtxt + -- ^ A 'UserTypeCtxt' that only represents kind-level positions. + | BothTypeAndKindCtxt + -- ^ A 'UserTypeCtxt' that can represent both type- and kind-level positions. + deriving Eq + +instance Outputable TypeOrKindCtxt where + ppr ctxt = text $ case ctxt of + OnlyTypeCtxt -> "OnlyTypeCtxt" + OnlyKindCtxt -> "OnlyKindCtxt" + BothTypeAndKindCtxt -> "BothTypeAndKindCtxt" + +-- | Determine whether a 'UserTypeCtxt' can represent type-level contexts, +-- kind-level contexts, or both. +typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt +typeOrKindCtxt (FunSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InfSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ExprSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (TypeAppCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSynCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (RuleSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ForSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DefaultDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InstDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SpecInstCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (GenSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ClassSCCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SigmaCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DataTyCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DerivClauseCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ConArgCtxt {}) = OnlyTypeCtxt + -- Although data constructors can be promoted with DataKinds, we always + -- validity-check them as though they are the types of terms. We may need + -- to revisit this decision if we ever allow visible dependent quantification + -- in the types of data constructors. + +typeOrKindCtxt (KindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (StandaloneKindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyVarBndrKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (DataKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TySynKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyFamResKindCtxt {}) = OnlyKindCtxt + +typeOrKindCtxt (TySynCtxt {}) = BothTypeAndKindCtxt + -- Type synonyms can have types and kinds on their RHSs +typeOrKindCtxt (GhciCtxt {}) = BothTypeAndKindCtxt + -- GHCi's :kind command accepts both types and kinds + +-- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the +-- context for a kind of a type, where the arbitrary use of constraints is +-- currently disallowed. +-- (See @Note [Constraints in kinds]@ in "GHC.Core.TyCo.Rep".) +-- If the 'UserTypeCtxt' can refer to both types and kinds, this function +-- conservatively returns 'True'. +-- +-- An example of something that is unambiguously the kind of a type is the +-- @Show a => a -> a@ in @type Foo :: Show a => a -> a at . On the other hand, the +-- same type in @foo :: Show a => a -> a@ is unambiguously the type of a term, +-- not the kind of a type, so it is permitted. allConstraintsAllowed :: UserTypeCtxt -> Bool --- We don't allow arbitrary constraints in kinds -allConstraintsAllowed (TyVarBndrKindCtxt {}) = False -allConstraintsAllowed (DataKindCtxt {}) = False -allConstraintsAllowed (TySynKindCtxt {}) = False -allConstraintsAllowed (TyFamResKindCtxt {}) = False -allConstraintsAllowed (StandaloneKindSigCtxt {}) = False -allConstraintsAllowed _ = True +allConstraintsAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> True + OnlyKindCtxt -> False + BothTypeAndKindCtxt -> True -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the -- context for the type of a term, where visible, dependent quantification is --- currently disallowed. +-- currently disallowed. If the 'UserTypeCtxt' can refer to both types and +-- kinds, this function conservatively returns 'True'. -- -- An example of something that is unambiguously the type of a term is the -- @forall a -> a -> a@ in @foo :: forall a -> a -> a at . On the other hand, the @@ -496,40 +557,10 @@ allConstraintsAllowed _ = True -- @testsuite/tests/dependent/should_fail/T16326_Fail*.hs@ (for places where -- VDQ is disallowed). vdqAllowed :: UserTypeCtxt -> Bool --- Currently allowed in the kinds of types... -vdqAllowed (KindSigCtxt {}) = True -vdqAllowed (StandaloneKindSigCtxt {}) = True -vdqAllowed (TySynCtxt {}) = True -vdqAllowed (ThBrackCtxt {}) = True -vdqAllowed (GhciCtxt {}) = True -vdqAllowed (TyVarBndrKindCtxt {}) = True -vdqAllowed (DataKindCtxt {}) = True -vdqAllowed (TySynKindCtxt {}) = True -vdqAllowed (TyFamResKindCtxt {}) = True --- ...but not in the types of terms. -vdqAllowed (ConArgCtxt {}) = False - -- We could envision allowing VDQ in data constructor types so long as the - -- constructor is only ever used at the type level, but for now, GHC adopts - -- the stance that VDQ is never allowed in data constructor types. -vdqAllowed (FunSigCtxt {}) = False -vdqAllowed (InfSigCtxt {}) = False -vdqAllowed (ExprSigCtxt {}) = False -vdqAllowed (TypeAppCtxt {}) = False -vdqAllowed (PatSynCtxt {}) = False -vdqAllowed (PatSigCtxt {}) = False -vdqAllowed (RuleSigCtxt {}) = False -vdqAllowed (ResSigCtxt {}) = False -vdqAllowed (ForSigCtxt {}) = False -vdqAllowed (DefaultDeclCtxt {}) = False --- We count class constraints as "types of terms". All of the cases below deal --- with class constraints. -vdqAllowed (InstDeclCtxt {}) = False -vdqAllowed (SpecInstCtxt {}) = False -vdqAllowed (GenSigCtxt {}) = False -vdqAllowed (ClassSCCtxt {}) = False -vdqAllowed (SigmaCtxt {}) = False -vdqAllowed (DataTyCtxt {}) = False -vdqAllowed (DerivClauseCtxt {}) = False +vdqAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> False + OnlyKindCtxt -> True + BothTypeAndKindCtxt -> True {- Note [Correctness and performance of type synonym validity checking] @@ -1329,11 +1360,9 @@ okIPCtxt (InfSigCtxt {}) = True okIPCtxt ExprSigCtxt = True okIPCtxt TypeAppCtxt = True okIPCtxt PatSigCtxt = True -okIPCtxt ResSigCtxt = True okIPCtxt GenSigCtxt = True okIPCtxt (ConArgCtxt {}) = True okIPCtxt (ForSigCtxt {}) = True -- ?? -okIPCtxt ThBrackCtxt = True okIPCtxt (GhciCtxt {}) = True okIPCtxt SigmaCtxt = True okIPCtxt (DataTyCtxt {}) = True ===================================== testsuite/tests/typecheck/should_fail/T18714.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +module T18714 where + +import GHC.Exts + +type Id a = a + +type F = Id (Any :: forall a. Show a => a -> a) ===================================== testsuite/tests/typecheck/should_fail/T18714.stderr ===================================== @@ -0,0 +1,7 @@ + +T18714.hs:11:14: error: + • Illegal constraint in a kind: forall a. Show a => a -> a + • In the first argument of ‘Id’, namely + ‘(Any :: forall a. Show a => a -> a)’ + In the type ‘Id (Any :: forall a. Show a => a -> a)’ + In the type declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -579,3 +579,4 @@ test('T18357a', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T18455', normal, compile_fail, ['']) test('T18534', normal, compile_fail, ['']) +test('T18714', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9df77fed8918bb335874a584a829ee32325cefb5...2f222b120e48df1b3d78f5501612d21c2a2dc470 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9df77fed8918bb335874a584a829ee32325cefb5...2f222b120e48df1b3d78f5501612d21c2a2dc470 You're receiving 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 21 20:46:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 21 Sep 2020 16:46:29 -0400 Subject: [Git][ghc/ghc][master] hadrian: Add extra-deps: happy-1.20 to stack.yaml Message-ID: <5f69112514aa4_80b11572e50135906cb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 1 changed file: - hadrian/stack.yaml Changes: ===================================== hadrian/stack.yaml ===================================== @@ -12,3 +12,6 @@ nix: - git - ncurses - perl + +extra-deps: +- happy-1.20.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaa51dcfdb729f130aeefeaeac15029b62096a74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaa51dcfdb729f130aeefeaeac15029b62096a74 You're receiving 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 21 21:17:17 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 21 Sep 2020 17:17:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Remove unused ThBrackCtxt and ResSigCtxt Message-ID: <5f69185d59d98_80ba5a1e5013598486@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 8a032e44 by Simon Peyton Jones at 2020-09-21T17:17:04-04: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. - - - - - 411d1425 by Sebastian Graf at 2020-09-21T17:17:04-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - 0cc0c034 by Sebastian Graf at 2020-09-21T17:17:04-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 22 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - hadrian/stack.yaml - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T - + testsuite/tests/simplCore/should_compile/T18603.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T18714.hs - + testsuite/tests/typecheck/should_fail/T18714.stderr - testsuite/tests/typecheck/should_fail/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 @@ -127,6 +123,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!) ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,10 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +#if __GLASGOW_HASKELL__ <= 900 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -221,7 +221,7 @@ safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning 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 +match var x, which rules out ⊥ as an inhabitant. So we add x ≁ ⊥ to the initial Nabla and check if there are any values left to match on. -} @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitingPatterns 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 /~ ⊥ + -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ PmBang x mb_info -> do - div <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: 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 isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1048,7 +1011,7 @@ How do we do that? Consider And imagine we set our limit to 1 for the sake of the example. The first clause 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}. +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 @@ -1056,8 +1019,8 @@ ensure not to make things worse as they are already, so we continue checking 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 -{x~True,y/~True}. +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 @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitingPatterns vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -416,7 +417,7 @@ instance Outputable PmEquality where -- | 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. +-- 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] @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -552,7 +558,7 @@ data VarInfo -- data T = Leaf Int | Branch T T | Node Int T -- @ -- - -- then @x /~ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- then @x ≁ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, -- and hence can only match @Branch at . Is orthogonal to anything from 'vi_pos', -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing -- between 'vi_pos' and 'vi_neg'. @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,9 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +#if __GLASGOW_HASKELL__ <= 900 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2838,7 +2838,6 @@ expectedKindInCtxt :: UserTypeCtxt -> ContextKind -- Depending on the context, we might accept any kind (for instance, in a TH -- splice), or only certain kinds (like in type signatures). expectedKindInCtxt (TySynCtxt _) = AnyKind -expectedKindInCtxt ThBrackCtxt = AnyKind expectedKindInCtxt (GhciCtxt {}) = AnyKind -- The types in a 'default' decl can have varying kinds -- See Note [Extended defaults]" in GHC.Tc.Utils.Env ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -84,15 +84,12 @@ data UserTypeCtxt -- or (x::t, y) = e | RuleSigCtxt Name -- LHS of a RULE forall -- RULE "foo" forall (x :: a -> a). f (Just x) = ... - | ResSigCtxt -- Result type sig - -- f x :: t = .... | ForSigCtxt Name -- Foreign import or export signature | DefaultDeclCtxt -- Types in a default declaration | InstDeclCtxt Bool -- An instance declaration -- True: stand-alone deriving -- False: vanilla instance declaration | SpecInstCtxt -- SPECIALISE instance pragma - | ThBrackCtxt -- Template Haskell type brackets [t| ... |] | GenSigCtxt -- Higher-rank or impredicative situations -- e.g. (f e) where f has a higher-rank type -- We might want to elaborate this @@ -136,9 +133,7 @@ pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature fo pprUserTypeCtxt TypeAppCtxt = text "a type argument" pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c) -pprUserTypeCtxt ThBrackCtxt = text "a Template Haskell quotation [t|...|]" pprUserTypeCtxt PatSigCtxt = text "a pattern type signature" -pprUserTypeCtxt ResSigCtxt = text "a result type signature" pprUserTypeCtxt (ForSigCtxt n) = text "the foreign declaration for" <+> quotes (ppr n) pprUserTypeCtxt DefaultDeclCtxt = text "a type in a `default' declaration" pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration" ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -348,7 +348,6 @@ checkValidType ctxt ty rank = case ctxt of DefaultDeclCtxt-> MustBeMonoType - ResSigCtxt -> MustBeMonoType PatSigCtxt -> rank0 RuleSigCtxt _ -> rank1 TySynCtxt _ -> rank0 @@ -372,7 +371,6 @@ checkValidType ctxt ty ForSigCtxt _ -> rank1 SpecInstCtxt -> rank1 - ThBrackCtxt -> rank1 GhciCtxt {} -> ArbitraryRank TyVarBndrKindCtxt _ -> rank0 @@ -472,18 +470,81 @@ forAllAllowed ArbitraryRank = True forAllAllowed (LimitedRank forall_ok _) = forall_ok forAllAllowed _ = False +-- | Indicates whether a 'UserTypeCtxt' represents type-level contexts, +-- kind-level contexts, or both. +data TypeOrKindCtxt + = OnlyTypeCtxt + -- ^ A 'UserTypeCtxt' that only represents type-level positions. + | OnlyKindCtxt + -- ^ A 'UserTypeCtxt' that only represents kind-level positions. + | BothTypeAndKindCtxt + -- ^ A 'UserTypeCtxt' that can represent both type- and kind-level positions. + deriving Eq + +instance Outputable TypeOrKindCtxt where + ppr ctxt = text $ case ctxt of + OnlyTypeCtxt -> "OnlyTypeCtxt" + OnlyKindCtxt -> "OnlyKindCtxt" + BothTypeAndKindCtxt -> "BothTypeAndKindCtxt" + +-- | Determine whether a 'UserTypeCtxt' can represent type-level contexts, +-- kind-level contexts, or both. +typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt +typeOrKindCtxt (FunSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InfSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ExprSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (TypeAppCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSynCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (PatSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (RuleSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ForSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DefaultDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (InstDeclCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SpecInstCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (GenSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ClassSCCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (SigmaCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DataTyCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (DerivClauseCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (ConArgCtxt {}) = OnlyTypeCtxt + -- Although data constructors can be promoted with DataKinds, we always + -- validity-check them as though they are the types of terms. We may need + -- to revisit this decision if we ever allow visible dependent quantification + -- in the types of data constructors. + +typeOrKindCtxt (KindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (StandaloneKindSigCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyVarBndrKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (DataKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TySynKindCtxt {}) = OnlyKindCtxt +typeOrKindCtxt (TyFamResKindCtxt {}) = OnlyKindCtxt + +typeOrKindCtxt (TySynCtxt {}) = BothTypeAndKindCtxt + -- Type synonyms can have types and kinds on their RHSs +typeOrKindCtxt (GhciCtxt {}) = BothTypeAndKindCtxt + -- GHCi's :kind command accepts both types and kinds + +-- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the +-- context for a kind of a type, where the arbitrary use of constraints is +-- currently disallowed. +-- (See @Note [Constraints in kinds]@ in "GHC.Core.TyCo.Rep".) +-- If the 'UserTypeCtxt' can refer to both types and kinds, this function +-- conservatively returns 'True'. +-- +-- An example of something that is unambiguously the kind of a type is the +-- @Show a => a -> a@ in @type Foo :: Show a => a -> a at . On the other hand, the +-- same type in @foo :: Show a => a -> a@ is unambiguously the type of a term, +-- not the kind of a type, so it is permitted. allConstraintsAllowed :: UserTypeCtxt -> Bool --- We don't allow arbitrary constraints in kinds -allConstraintsAllowed (TyVarBndrKindCtxt {}) = False -allConstraintsAllowed (DataKindCtxt {}) = False -allConstraintsAllowed (TySynKindCtxt {}) = False -allConstraintsAllowed (TyFamResKindCtxt {}) = False -allConstraintsAllowed (StandaloneKindSigCtxt {}) = False -allConstraintsAllowed _ = True +allConstraintsAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> True + OnlyKindCtxt -> False + BothTypeAndKindCtxt -> True -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the -- context for the type of a term, where visible, dependent quantification is --- currently disallowed. +-- currently disallowed. If the 'UserTypeCtxt' can refer to both types and +-- kinds, this function conservatively returns 'True'. -- -- An example of something that is unambiguously the type of a term is the -- @forall a -> a -> a@ in @foo :: forall a -> a -> a at . On the other hand, the @@ -496,40 +557,10 @@ allConstraintsAllowed _ = True -- @testsuite/tests/dependent/should_fail/T16326_Fail*.hs@ (for places where -- VDQ is disallowed). vdqAllowed :: UserTypeCtxt -> Bool --- Currently allowed in the kinds of types... -vdqAllowed (KindSigCtxt {}) = True -vdqAllowed (StandaloneKindSigCtxt {}) = True -vdqAllowed (TySynCtxt {}) = True -vdqAllowed (ThBrackCtxt {}) = True -vdqAllowed (GhciCtxt {}) = True -vdqAllowed (TyVarBndrKindCtxt {}) = True -vdqAllowed (DataKindCtxt {}) = True -vdqAllowed (TySynKindCtxt {}) = True -vdqAllowed (TyFamResKindCtxt {}) = True --- ...but not in the types of terms. -vdqAllowed (ConArgCtxt {}) = False - -- We could envision allowing VDQ in data constructor types so long as the - -- constructor is only ever used at the type level, but for now, GHC adopts - -- the stance that VDQ is never allowed in data constructor types. -vdqAllowed (FunSigCtxt {}) = False -vdqAllowed (InfSigCtxt {}) = False -vdqAllowed (ExprSigCtxt {}) = False -vdqAllowed (TypeAppCtxt {}) = False -vdqAllowed (PatSynCtxt {}) = False -vdqAllowed (PatSigCtxt {}) = False -vdqAllowed (RuleSigCtxt {}) = False -vdqAllowed (ResSigCtxt {}) = False -vdqAllowed (ForSigCtxt {}) = False -vdqAllowed (DefaultDeclCtxt {}) = False --- We count class constraints as "types of terms". All of the cases below deal --- with class constraints. -vdqAllowed (InstDeclCtxt {}) = False -vdqAllowed (SpecInstCtxt {}) = False -vdqAllowed (GenSigCtxt {}) = False -vdqAllowed (ClassSCCtxt {}) = False -vdqAllowed (SigmaCtxt {}) = False -vdqAllowed (DataTyCtxt {}) = False -vdqAllowed (DerivClauseCtxt {}) = False +vdqAllowed ctxt = case typeOrKindCtxt ctxt of + OnlyTypeCtxt -> False + OnlyKindCtxt -> True + BothTypeAndKindCtxt -> True {- Note [Correctness and performance of type synonym validity checking] @@ -1329,11 +1360,9 @@ okIPCtxt (InfSigCtxt {}) = True okIPCtxt ExprSigCtxt = True okIPCtxt TypeAppCtxt = True okIPCtxt PatSigCtxt = True -okIPCtxt ResSigCtxt = True okIPCtxt GenSigCtxt = True okIPCtxt (ConArgCtxt {}) = True okIPCtxt (ForSigCtxt {}) = True -- ?? -okIPCtxt ThBrackCtxt = True okIPCtxt (GhciCtxt {}) = True okIPCtxt SigmaCtxt = True okIPCtxt (DataTyCtxt {}) = True ===================================== hadrian/stack.yaml ===================================== @@ -12,3 +12,6 @@ nix: - git - ncurses - perl + +extra-deps: +- happy-1.20.0 ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, ===================================== 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,6 +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']) +test('T18603', 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_fail/T18714.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +module T18714 where + +import GHC.Exts + +type Id a = a + +type F = Id (Any :: forall a. Show a => a -> a) ===================================== testsuite/tests/typecheck/should_fail/T18714.stderr ===================================== @@ -0,0 +1,7 @@ + +T18714.hs:11:14: error: + • Illegal constraint in a kind: forall a. Show a => a -> a + • In the first argument of ‘Id’, namely + ‘(Any :: forall a. Show a => a -> a)’ + In the type ‘Id (Any :: forall a. Show a => a -> a)’ + In the type declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -579,3 +579,4 @@ test('T18357a', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T18455', normal, compile_fail, ['']) test('T18534', normal, compile_fail, ['']) +test('T18714', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/629a10f189a5ebf06cc5d34a872f22830cb2593e...0cc0c034e0b6f47844f62450f80aca9280e2c25f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/629a10f189a5ebf06cc5d34a872f22830cb2593e...0cc0c034e0b6f47844f62450f80aca9280e2c25f You're receiving 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 22 00:10:07 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 21 Sep 2020 20:10:07 -0400 Subject: [Git][ghc/ghc][wip/T18723] WIP: Check for large tuples more thoroughly in the typechecker Message-ID: <5f6940dfbe5ff_80b3f84869382cc136101ab@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T18723 at Glasgow Haskell Compiler / GHC Commits: 8af17561 by Ryan Scott at 2020-09-21T20:07:06-04:00 WIP: Check for large tuples more thoroughly in the typechecker This unifies the treatment of how GHC checks for constraint tuples and other tuples by: * Migrating the `checkTupSize` renamer check to the typechecker, * Moving the existing `bigConstraintTuple` typechecker validity check to `checkCTupSize` for consistency with `checkTupSize`, and * Consistently using `check(C)TupSize` when typechecking tuple names, expressions, patterns, and types. Fixes #18723. - - - - - 24 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - testsuite/tests/polykinds/T10451.stderr - − testsuite/tests/rename/should_fail/T6148.stderr - + testsuite/tests/rename/should_fail/T6148a.hs - + testsuite/tests/rename/should_fail/T6148a.stderr - + testsuite/tests/rename/should_fail/T6148b.hs - + testsuite/tests/rename/should_fail/T6148b.stderr - testsuite/tests/rename/should_fail/T6148.hs → testsuite/tests/rename/should_fail/T6148c.hs - + testsuite/tests/rename/should_fail/T6148c.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_fail/T18723a.hs - + testsuite/tests/typecheck/should_fail/T18723a.stderr - + testsuite/tests/typecheck/should_fail/T18723b.hs - + testsuite/tests/typecheck/should_fail/T18723b.stderr - + testsuite/tests/typecheck/should_fail/T18723c.hs - + testsuite/tests/typecheck/should_fail/T18723c.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Iface.Load ( -- Importing one thing tcLookupImported_maybe, importDecl, checkWiredInTyCon, ifCheckWiredInThing, + checkTupSize, checkCTupSize, -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, @@ -56,6 +57,8 @@ import GHC.Builtin.Names import GHC.Builtin.Utils import GHC.Builtin.PrimOps ( allThePrimOps, primOpFixity, primOpOcc ) import GHC.Types.Id.Make ( seqId, EnableBignumRules(..) ) +import GHC.Core.ConLike +import GHC.Core.DataCon import GHC.Core.Rules import GHC.Core.TyCon import GHC.Types.Annotations @@ -78,7 +81,6 @@ import GHC.Utils.Misc import GHC.Data.FastString import GHC.Utils.Fingerprint import GHC.Driver.Hooks -import GHC.Types.FieldLabel import GHC.Iface.Rename import GHC.Types.Unique.DSet import GHC.Driver.Plugins @@ -133,9 +135,28 @@ tcImportDecl_maybe name = do { when (needWiredInHomeIface thing) (initIfaceTcRn (loadWiredInHomeIface name)) -- See Note [Loading instances for wired-in things] + ; whenIsJust (tuple_ty_thing_maybe thing) checkTupSize ; return (Succeeded thing) } | otherwise = initIfaceTcRn (importDecl name) + where + -- Returns @Just arity@ if the supplied TyThing corresponds to a tuple + -- type or data constructor. Returns @Nothing@ otherwise. + tuple_ty_thing_maybe :: TyThing -> Maybe Arity + tuple_ty_thing_maybe thing + | Just tycon <- case thing of + ATyCon tc -> Just tc + AConLike (RealDataCon dc) -> Just (dataConTyCon dc) + _ -> Nothing + , Just tupleSort <- tyConTuple_maybe tycon + = Just $ case tupleSort of + -- Unboxed tuples have twice as many arguments because of the + -- 'RuntimeRep's (#17837) + UnboxedTuple -> tyConArity tycon `div` 2 + _ -> tyConArity tycon + + | otherwise + = Nothing importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing) -- Get the TyThing for this Name from an interface file @@ -249,6 +270,27 @@ needWiredInHomeIface :: TyThing -> Bool needWiredInHomeIface (ATyCon {}) = True needWiredInHomeIface _ = False +-- | Ensure that a boxed or unboxed tuple has arity no larger than +-- 'mAX_TUPLE_SIZE'. +checkTupSize :: Int -> TcM () +checkTupSize tup_size + | tup_size <= mAX_TUPLE_SIZE + = return () + | otherwise + = addErr (sep [text "A" <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), + nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), + nest 2 (text "Workaround: use nested tuples or define a data type")]) + +-- | Ensure that a constraint tuple has arity no larger than 'mAX_CTUPLE_SIZE'. +checkCTupSize :: Int -> TcM () +checkCTupSize tup_size + | tup_size <= mAX_CTUPLE_SIZE + = return () + | otherwise + = addErr (hang (text "Constraint tuple arity too large:" <+> int tup_size + <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) + 2 (text "Instead, use a nested tuple")) + {- ************************************************************************ ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Utils.Error ( MsgDoc ) import GHC.Builtin.Names( rOOT_MAIN ) -import GHC.Types.Basic ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) ) +import GHC.Types.Basic ( pprWarningTxtForMsg, TopLevelFlag(..) ) import GHC.Types.SrcLoc as SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Types.Unique.Set ( uniqSetAny ) @@ -278,20 +278,6 @@ lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn -- Note [Errors in lookup functions] lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name) lookupExactOcc_either name - | Just thing <- wiredInNameTyThing_maybe name - , Just tycon <- case thing of - ATyCon tc -> Just tc - AConLike (RealDataCon dc) -> Just (dataConTyCon dc) - _ -> Nothing - , Just tupleSort <- tyConTuple_maybe tycon - = do { let tupArity = case tupleSort of - -- Unboxed tuples have twice as many arguments because of the - -- 'RuntimeRep's (#17837) - UnboxedTuple -> tyConArity tycon `div` 2 - _ -> tyConArity tycon - ; checkTupSize tupArity - ; return (Right name) } - | isExternalName name = return (Right name) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -282,7 +282,6 @@ rnExpr (ExplicitList x _ exps) rnExpr (ExplicitTuple x tup_args boxity) = do { checkTupleSection tup_args - ; checkTupSize (length tup_args) ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args ; return (ExplicitTuple x tup_args' boxity, plusFVs fvs) } where ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -38,8 +38,8 @@ module GHC.Rename.Pat (-- main entry points -- Literals rnLit, rnOverLit, - -- Pattern Error messages that are also used elsewhere - checkTupSize, patSigErr + -- Pattern Error message that is also used elsewhere + patSigErr ) where -- ENH: thin imports to only what is necessary for patterns @@ -60,7 +60,7 @@ import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames , warnUnusedMatches, newLocalBndrRn , checkUnusedRecordWildcard , checkDupNames, checkDupAndShadowedNames - , checkTupSize , unknownSubordinateErr ) + , unknownSubordinateErr ) import GHC.Rename.HsType import GHC.Builtin.Names import GHC.Types.Name @@ -498,8 +498,7 @@ rnPatAndThen mk (ListPat _ pats) False -> return (ListPat Nothing pats') } rnPatAndThen mk (TuplePat x pats boxed) - = do { liftCps $ checkTupSize (length pats) - ; pats' <- rnLPatsAndThen mk pats + = do { pats' <- rnLPatsAndThen mk pats ; return (TuplePat x pats' boxed) } rnPatAndThen mk (SumPat x pat alt arity) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -12,7 +12,6 @@ This module contains miscellaneous functions related to renaming. module GHC.Rename.Utils ( checkDupRdrNames, checkShadowedRdrNames, checkDupNames, checkDupAndShadowedNames, dupNamesErr, - checkTupSize, addFvRn, mapFvRn, mapMaybeFvRn, warnUnusedMatches, warnUnusedTypePatterns, warnUnusedTopBinds, warnUnusedLocalBinds, @@ -58,7 +57,6 @@ import GHC.Driver.Session import GHC.Data.FastString import Control.Monad import Data.List -import GHC.Settings.Constants ( mAX_TUPLE_SIZE ) import qualified Data.List.NonEmpty as NE import qualified GHC.LanguageExtensions as LangExt @@ -573,15 +571,6 @@ typeAppErr what (L _ k) <+> quotes (char '@' <> ppr k)) 2 (text "Perhaps you intended to use TypeApplications") -checkTupSize :: Int -> RnM () -checkTupSize tup_size - | tup_size <= mAX_TUPLE_SIZE - = return () - | otherwise - = addErr (sep [text "A" <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), - nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), - nest 2 (text "Workaround: use nested tuples or define a data type")]) - {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -31,6 +31,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntyp import GHC.Builtin.Names.TH( liftStringName, liftName ) import GHC.Hs +import GHC.Iface.Load import GHC.Tc.Utils.Zonk import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Unify @@ -1548,7 +1549,9 @@ tcArg fun arg (Scaled mult ty) arg_no ---------------- tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc] tcTupArgs args tys - = ASSERT( equalLength args tys ) mapM go (args `zip` tys) + = do MASSERT( equalLength args tys ) + checkTupSize (length args) + mapM go (args `zip` tys) where go (L l (Missing {}), arg_ty) = do { mult <- newFlexiTyVarTy multiplicityTy ; return (L l (Missing (Scaled mult arg_ty))) } ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -83,6 +83,7 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Validity import GHC.Tc.Utils.Unify import GHC.IfaceToCore +import GHC.Iface.Load import GHC.Tc.Solver import GHC.Tc.Utils.Zonk import GHC.Core.TyCo.Rep @@ -106,8 +107,6 @@ import GHC.Types.Var.Env import GHC.Builtin.Types import GHC.Types.Basic import GHC.Types.SrcLoc -import GHC.Settings.Constants ( mAX_CTUPLE_SIZE ) -import GHC.Utils.Error( MsgDoc ) import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set @@ -1112,6 +1111,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind ; let kind_con = tupleTyCon Boxed arity ty_con = promotedTupleDataCon Boxed arity tup_k = mkTyConApp kind_con ks + ; checkTupSize arity ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } where arity = length tys @@ -1266,33 +1266,28 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do -- Drop any uses of 1-tuple constraints here. -- See Note [Ignore unary constraint tuples] -> check_expected_kind tau_ty constraintKind - | arity > mAX_CTUPLE_SIZE - -> failWith (bigConstraintTuple arity) | otherwise - -> let tycon = cTupleTyCon arity in - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> do let tycon = cTupleTyCon arity + checkCTupSize arity + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity + checkTupSize arity checkWiredInTyCon tycon check_expected_kind (mkTyConApp tycon tau_tys) liftedTypeKind - UnboxedTuple -> + UnboxedTuple -> do let tycon = tupleTyCon Unboxed arity tau_reps = map kindRep tau_kinds -- See also Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon arg_tys = tau_reps ++ tau_tys - res_kind = unboxedTupleKind tau_reps in + res_kind = unboxedTupleKind tau_reps + checkTupSize arity check_expected_kind (mkTyConApp tycon arg_tys) res_kind where arity = length tau_tys check_expected_kind ty act_kind = checkExpectedKind rn_ty ty act_kind exp_kind -bigConstraintTuple :: Arity -> MsgDoc -bigConstraintTuple arity - = hang (text "Constraint tuple arity too large:" <+> int arity - <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) - 2 (text "Instead, use a nested tuple") - {- Note [Ignore unary constraint tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho ) import GHC.Hs +import GHC.Iface.Load import GHC.Tc.Utils.Zonk import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags ) import GHC.Tc.Utils.Monad @@ -511,6 +512,7 @@ Fortunately that's what matchExpectedFunTySigma returns anyway. tc = tupleTyCon boxity arity -- NB: tupleTyCon does not flatten 1-tuples -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make + ; checkTupSize arity ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc) penv (scaledThing pat_ty) -- Unboxed tuples have RuntimeRep vars, which we discard: ===================================== testsuite/tests/polykinds/T10451.stderr ===================================== @@ -1,11 +1,12 @@ T10451.hs:22:12: error: - Constraint tuple arity too large: 64 (max arity = 62) - Instead, use a nested tuple - In the type ‘(Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a)’ - In the type declaration for ‘T’ + • Constraint tuple arity too large: 64 (max arity = 62) + Instead, use a nested tuple + • In the type ‘(Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a)’ + In the type declaration for ‘T’ ===================================== testsuite/tests/rename/should_fail/T6148.stderr deleted ===================================== @@ -1,15 +0,0 @@ - -T6148.hs:3:5: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type - -T6148.hs:7:5: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type - -T6148.hs:11:6: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type ===================================== testsuite/tests/rename/should_fail/T6148a.hs ===================================== @@ -0,0 +1,4 @@ +module T6148a where + +a = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ===================================== testsuite/tests/rename/should_fail/T6148a.stderr ===================================== @@ -0,0 +1,13 @@ + +T6148a.hs:3:5: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the expression: + (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + In an equation for ‘a’: + a = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ===================================== testsuite/tests/rename/should_fail/T6148b.hs ===================================== @@ -0,0 +1,3 @@ +module T6148b where + +b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) ===================================== testsuite/tests/rename/should_fail/T6148b.stderr ===================================== @@ -0,0 +1,9 @@ + +T6148b.hs:3:5: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the expression: + (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) + In an equation for ‘b’: + b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) ===================================== testsuite/tests/rename/should_fail/T6148.hs → testsuite/tests/rename/should_fail/T6148c.hs ===================================== @@ -1,14 +1,8 @@ -module T6148 where - -a = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) - - -b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) +module T6148c where data T = T -c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) +c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T ===================================== testsuite/tests/rename/should_fail/T6148c.stderr ===================================== @@ -0,0 +1,7 @@ + +T6148c.hs:5:6: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type signature: + c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -87,7 +87,9 @@ test('T5892b', normal, compile_fail, ['-package containers']) test('T5951', normal, compile_fail, ['']) test('T6018rnfail', normal, compile_fail, ['']) test('T6060', normal, compile_fail, ['']) -test('T6148', normal, compile_fail, ['']) +test('T6148a', normal, compile_fail, ['']) +test('T6148b', normal, compile_fail, ['']) +test('T6148c', normal, compile_fail, ['']) test('T7164', normal, compile_fail, ['']) test('T7338', normal, compile_fail, ['']) test('T7338a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18723a.hs ===================================== @@ -0,0 +1,11 @@ +module T18723a where + +data T1 = MkT1 + ( Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + ) ===================================== testsuite/tests/typecheck/should_fail/T18723a.stderr ===================================== @@ -0,0 +1,13 @@ + +T18723a.hs:4:3: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type ‘(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int)’ + In the definition of data constructor ‘MkT1’ + In the data declaration for ‘T1’ ===================================== testsuite/tests/typecheck/should_fail/T18723b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +module T18723b where + +import Data.Proxy + +data T2 = MkT2 (Proxy + '( Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + )) ===================================== testsuite/tests/typecheck/should_fail/T18723b.stderr ===================================== @@ -0,0 +1,133 @@ + +T18723b.hs:7:2: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the first argument of ‘Proxy’, namely + ‘'(Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int)’ + In the type ‘(Proxy '(Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int))’ + In the definition of data constructor ‘MkT2’ ===================================== testsuite/tests/typecheck/should_fail/T18723c.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE UnboxedTuples #-} +module T18723c where + +data T3 = MkT3 + (# Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + #) ===================================== testsuite/tests/typecheck/should_fail/T18723c.stderr ===================================== @@ -0,0 +1,13 @@ + +T18723c.hs:5:2: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type ‘(# Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int #)’ + In the definition of data constructor ‘MkT3’ + In the data declaration for ‘T3’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -579,3 +579,6 @@ test('T18357a', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T18455', normal, compile_fail, ['']) test('T18534', normal, compile_fail, ['']) +test('T18723a', normal, compile_fail, ['']) +test('T18723b', normal, compile_fail, ['']) +test('T18723c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8af17561b3a504de26cef5ca465cba7283fc4f6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8af17561b3a504de26cef5ca465cba7283fc4f6c You're receiving 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 22 03:57:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 21 Sep 2020 23:57:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Better eta-expansion (again) and don't specilise DFuns Message-ID: <5f69762596b62_80b3f84688c970013622857@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 19343cd2 by Simon Peyton Jones at 2020-09-21T23:57:18-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 066f72a6 by Simon Peyton Jones at 2020-09-21T23:57:18-04: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. - - - - - 43083aed by Sebastian Graf at 2020-09-21T23:57:18-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9abf8da by Sebastian Graf at 2020-09-21T23:57:18-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 19 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc0c034e0b6f47844f62450f80aca9280e2c25f...e9abf8daca866c326195586a19be3477a5d0a0d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0cc0c034e0b6f47844f62450f80aca9280e2c25f...e9abf8daca866c326195586a19be3477a5d0a0d4 You're receiving 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 22 09:09:41 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 22 Sep 2020 05:09:41 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f69bf55ce9d7_80b3f849558ca6013640930@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 412a98d7 by Sebastian Graf at 2020-09-22T11:07:48+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * The `abs_binds` of an `AbsBinds` post type-checking, or * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 3 changed files: - compiler/GHC/HsToCore/PmCheck.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -58,6 +58,7 @@ import GHC.HsToCore.PmCheck.Ppr import GHC.Types.Basic (Origin(..), isGenerated) import GHC.Core (CoreExpr, Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Driver.Types import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -72,6 +73,7 @@ import GHC.Utils.Panic import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion +import GHC.Tc.Types import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr) @@ -80,7 +82,7 @@ import GHC.HsToCore.Utils (selectMatchVar) import GHC.HsToCore.Match.Literal (dsLit, dsOverLit) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Core.TyCo.Rep import GHC.Core.Type @@ -111,12 +113,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | 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 <- getLdiNablas - pat_bind <- desugarPatBind loc var p + missing <- getLdiNablas + pat_bind <- noCheckDs $ 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)) @@ -133,8 +145,8 @@ covCheckGRHSs 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 <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards + missing <- getLdiNablas tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -142,7 +154,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -178,13 +190,13 @@ covCheckMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -322,7 +334,11 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of local binds for long-distance +-- information and the actual list of 'GRHS'. +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -363,6 +379,10 @@ instance Outputable (PmMatch Pre) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = pprLygGuards grds <+> ppr grhss +instance Outputable (PmGRHSs Pre) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Pre) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs @@ -388,6 +408,10 @@ instance Outputable (PmMatch Post) where ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = pprRedSets red <+> ppr grhss +instance Outputable (PmGRHSs Post) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable (PmGRHS Post) where ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = pprRedSets red <+> text "->" <+> pprSrcInfo rhs @@ -699,12 +723,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -724,7 +750,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM GrdVec desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -732,9 +758,32 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec -desugarLet _binds = return [] +-- | Desugar local (let and where) bindings +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM GrdVec +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + -- We are only interested in FunBinds with single match groups without any + -- patterns. + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{abs_exports=exports, abs_binds = binds}) = do + -- Just assign polymorphic binders the same semantics as their monomorphic + -- counterpart if their types match. This is crucial for making sense + -- about any HsLocalBinds at all. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y} + | idType x `eqType` idType y = Just $ PmLet x (Var y) + | otherwise = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -1019,8 +1068,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = @@ -1085,7 +1135,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -1161,8 +1214,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -142,6 +142,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('T18626', 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, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/412a98d7f3e56c95c4dd6813a745f6dd896873ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/412a98d7f3e56c95c4dd6813a745f6dd896873ed You're receiving 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 22 09:37:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 22 Sep 2020 05:37:36 -0400 Subject: [Git][ghc/ghc][master] Better eta-expansion (again) and don't specilise DFuns Message-ID: <5f69c5e0d705d_80b3f8486fb6d4c136476e6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 16 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - testsuite/tests/perf/compiler/Makefile - testsuite/tests/perf/compiler/T16473.stdout - + testsuite/tests/perf/compiler/T18223.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/printer/T18052a.stderr - testsuite/tests/simplCore/should_compile/T17966.stdout - testsuite/tests/stranal/should_compile/T18122.stderr Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -31,7 +31,7 @@ module GHC.Core.Coercion ( mkAxInstRHS, mkUnbranchedAxInstRHS, mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, - mkSymCo, mkTransCo, mkTransMCo, + mkSymCo, mkTransCo, mkNthCo, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, @@ -65,7 +65,8 @@ module GHC.Core.Coercion ( pickLR, isGReflCo, isReflCo, isReflCo_maybe, isGReflCo_maybe, isReflexiveCo, isReflexiveCo_maybe, - isReflCoVar_maybe, isGReflMCo, coToMCo, + isReflCoVar_maybe, isGReflMCo, + coToMCo, mkTransMCo, mkTransMCoL, -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, @@ -288,6 +289,44 @@ tidyCoAxBndrsForUser init_env tcvs ('_' : rest) -> all isDigit rest _ -> False + +{- ********************************************************************* +* * + MCoercion +* * +********************************************************************* -} + +coToMCo :: Coercion -> MCoercion +-- Convert a coercion to a MCoercion, +-- It's not clear whether or not isReflexiveCo would be better here +coToMCo co | isReflCo co = MRefl + | otherwise = MCo co + +-- | Tests if this MCoercion is obviously generalized reflexive +-- Guaranteed to work very quickly. +isGReflMCo :: MCoercion -> Bool +isGReflMCo MRefl = True +isGReflMCo (MCo co) | isGReflCo co = True +isGReflMCo _ = False + +-- | Make a generalized reflexive coercion +mkGReflCo :: Role -> Type -> MCoercionN -> Coercion +mkGReflCo r ty mco + | isGReflMCo mco = if r == Nominal then Refl ty + else GRefl r ty MRefl + | otherwise = GRefl r ty mco + +-- | Compose two MCoercions via transitivity +mkTransMCo :: MCoercion -> MCoercion -> MCoercion +mkTransMCo MRefl co2 = co2 +mkTransMCo co1 MRefl = co1 +mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2) + +mkTransMCoL :: MCoercion -> Coercion -> MCoercion +mkTransMCoL MRefl co2 = MCo co2 +mkTransMCoL (MCo co1) co2 = MCo (mkTransCo co1 co2) + + {- %************************************************************************ %* * @@ -556,13 +595,6 @@ isGReflCo (GRefl{}) = True isGReflCo (Refl{}) = True -- Refl ty == GRefl N ty MRefl isGReflCo _ = False --- | Tests if this MCoercion is obviously generalized reflexive --- Guaranteed to work very quickly. -isGReflMCo :: MCoercion -> Bool -isGReflMCo MRefl = True -isGReflMCo (MCo co) | isGReflCo co = True -isGReflMCo _ = False - -- | Tests if this coercion is obviously reflexive. Guaranteed to work -- very quickly. Sometimes a coercion can be reflexive, but not obviously -- so. c.f. 'isReflexiveCo' @@ -603,10 +635,6 @@ isReflexiveCo_maybe co = Nothing where (Pair ty1 ty2, r) = coercionKindRole co -coToMCo :: Coercion -> MCoercion -coToMCo c = if isReflCo c - then MRefl - else MCo c {- %************************************************************************ @@ -669,13 +697,6 @@ role is bizarre and a caller should have to ask for this behavior explicitly. -} --- | Make a generalized reflexive coercion -mkGReflCo :: Role -> Type -> MCoercionN -> Coercion -mkGReflCo r ty mco - | isGReflMCo mco = if r == Nominal then Refl ty - else GRefl r ty MRefl - | otherwise = GRefl r ty mco - -- | Make a reflexive coercion mkReflCo :: Role -> Type -> Coercion mkReflCo Nominal ty = Refl ty @@ -990,12 +1011,6 @@ mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo co1 co2 = TransCo co1 co2 --- | Compose two MCoercions via transitivity -mkTransMCo :: MCoercion -> MCoercion -> MCoercion -mkTransMCo MRefl co2 = co2 -mkTransMCo co1 MRefl = co1 -mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2) - mkNthCo :: HasDebugCallStack => Role -- The role of the coercion you're creating -> Int -- Zero-indexed ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -15,10 +15,18 @@ module GHC.Core.Opt.Arity ( manifestArity, joinRhsArity, exprArity, typeArity , exprEtaExpandArity, findRhsArity , etaExpand, etaExpandAT - , etaExpandToJoinPoint, etaExpandToJoinPointRule , exprBotStrictness_maybe + + -- ** ArityType , ArityType(..), expandableArityType, arityTypeArity , maxWithArity, isBotArityType, idArityType + + -- ** Join points + , etaExpandToJoinPoint, etaExpandToJoinPointRule + + -- ** Coercions and casts + , pushCoArg, pushCoArgs, pushCoValArg, pushCoTyArg + , pushCoercionIntoLambda, pushCoDataCon, collectBindersPushingCo ) where @@ -31,15 +39,21 @@ import GHC.Driver.Ppr import GHC.Core import GHC.Core.FVs import GHC.Core.Utils -import GHC.Core.Subst import GHC.Types.Demand import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Id -import GHC.Core.Type as Type -import GHC.Core.TyCon ( initRecTc, checkRecTc ) + +-- We have two sorts of substitution: +-- GHC.Core.Subst.Subst, and GHC.Core.TyCo.TCvSubst +-- Both have substTy, substCo Hence need for qualification +import GHC.Core.Subst as Core +import GHC.Core.Type as Type +import GHC.Core.Coercion as Type + +import GHC.Core.DataCon +import GHC.Core.TyCon ( initRecTc, checkRecTc, tyConArity ) import GHC.Core.Predicate ( isDictTy ) -import GHC.Core.Coercion as Coercion import GHC.Core.Multiplicity import GHC.Types.Var.Set import GHC.Types.Basic @@ -48,7 +62,8 @@ import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Utils.Misc ( lengthAtLeast ) +import GHC.Data.Pair +import GHC.Utils.Misc {- ************************************************************************ @@ -1076,12 +1091,11 @@ eta_expand one_shots orig_expr go oss (Cast expr co) = Cast (go oss expr) co go oss expr - = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, ppr etas]) $ - retick $ etaInfoAbs etas (etaInfoApp subst' sexpr etas) + = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, pprEtaInfos etas]) $ + retick $ etaInfoAbs etas (etaInfoApp in_scope' sexpr etas) where in_scope = mkInScopeSet (exprFreeVars expr) (in_scope', etas) = mkEtaWW oss (ppr orig_expr) in_scope (exprType expr) - subst' = mkEmptySubst in_scope' -- Find ticks behind type apps. -- See Note [Eta expansion and source notes] @@ -1090,76 +1104,197 @@ eta_expand one_shots orig_expr sexpr = foldl' App expr'' args retick expr = foldr mkTick expr ticks - -- Abstraction Application +{- ********************************************************************* +* * + The EtaInfo mechanism + mkEtaWW, etaInfoAbs, etaInfoApp +* * +********************************************************************* -} + +{- Note [The EtaInfo mechanism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have (e :: ty) and we want to eta-expand it to arity N. +This what eta_expand does. We do it in two steps: + +1. mkEtaWW: from 'ty' and 'N' build a [EtaInfo] which describes + the shape of the expansion necessary to expand to arity N. + +2. Build the term + \ v1..vn. e v1 .. vn + where those abstractions and applications are described by + the same [EtaInfo]. Specifically we build the term + + etaInfoAbs etas (etaInfoApp in_scope e etas) + + where etas :: [EtaInfo]# + etaInfoAbs builds the lambdas + etaInfoApp builds the applictions + + Note that the /same/ [EtaInfo] drives both etaInfoAbs and etaInfoApp + +To a first approximation [EtaInfo] is just [Var]. But +casts complicate the question. If we have + newtype N a = MkN (S -> a) +and + ty = N (N Int) +then the eta-expansion must look like + (\x (\y. ((e |> co1) x) |> co2) y) + |> sym co2) + |> sym co1 +where + co1 :: N (N Int) ~ S -> N Int + co2 :: N Int ~ S -> Int + +Blimey! Look at all those casts. Moreover, if the type +is very deeply nested (as happens in #18223), the repetition +of types can make the overall term very large. So there is a big +payoff in cancelling out casts aggressively wherever possible. +(See also Note [No crap in eta-expanded code].) + +This matters a lot in etaEInfoApp, where we +* Do beta-reduction on the fly +* Use getARg_mabye to get a cast out of the way, + so that we can do beta reduction +Together this makes a big difference. Consider when e is + case x of + True -> (\x -> e1) |> c1 + False -> (\p -> e2) |> c2 + +When we eta-expand this to arity 1, say, etaInfoAbs will wrap +a (\eta) around the outside and use etaInfoApp to apply each +alternative to 'eta'. We want to beta-reduce all that junk +away. + +#18223 was a dramtic example in which the intermediate term was +grotesquely huge, even though the next Simplifier iteration squashed +it. Better to kill it at birth. +-} + -------------- -data EtaInfo = EtaVar Var -- /\a. [] [] a - -- \x. [] [] x - | EtaCo Coercion -- [] |> sym co [] |> co +data EtaInfo -- Abstraction Application + = EtaVar Var -- /\a. [] [] a + -- (\x. []) [] x + | EtaCo CoercionR -- [] |> sym co [] |> co instance Outputable EtaInfo where - ppr (EtaVar v) = text "EtaVar" <+> ppr v - ppr (EtaCo co) = text "EtaCo" <+> ppr co + ppr (EtaVar v) = text "EtaVar" <+> ppr v <+> dcolon <+> ppr (idType v) + ppr (EtaCo co) = text "EtaCo" <+> hang (ppr co) 2 (dcolon <+> ppr (coercionType co)) + +-- Used in debug-printing +-- pprEtaInfos :: [EtaInfo] -> SDoc +-- pprEtaInfos eis = brackets $ vcat $ punctuate comma $ map ppr eis pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo] +-- Puts a EtaCo on the front of a [EtaInfo], but combining +-- with an existing EtaCo if possible +-- A minor improvement pushCoercion co1 (EtaCo co2 : eis) | isReflCo co = eis | otherwise = EtaCo co : eis where co = co1 `mkTransCo` co2 -pushCoercion co eis = EtaCo co : eis +pushCoercion co eis + = EtaCo co : eis + +getArg_maybe :: [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) +-- Get an argument to the front of the [EtaInfo], if possible, +-- by pushing any EtaCo through the argument +getArg_maybe eis = go MRefl eis + where + go :: MCoercion -> [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) + go _ [] = Nothing + go mco (EtaCo co2 : eis) = go (mkTransMCoL mco co2) eis + go MRefl (EtaVar v : eis) = Just (varToCoreExpr v, eis) + go (MCo co) (EtaVar v : eis) + | Just (arg, mco) <- pushCoArg co (varToCoreExpr v) + = case mco of + MRefl -> Just (arg, eis) + MCo co -> Just (arg, pushCoercion co eis) + | otherwise + = Nothing + +mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr +mkCastMCo e MRefl = e +mkCastMCo e (MCo co) = Cast e co + -- We are careful to use (MCo co) only when co is not reflexive + -- Hence (Cast e co) rather than (mkCast e co) + +mkPiMCo :: Var -> MCoercionR -> MCoercionR +mkPiMCo _ MRefl = MRefl +mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) -------------- etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr -etaInfoAbs [] expr = expr -etaInfoAbs (EtaVar v : eis) expr = Lam v (etaInfoAbs eis expr) -etaInfoAbs (EtaCo co : eis) expr = Cast (etaInfoAbs eis expr) (mkSymCo co) +-- See Note [The EtaInfo mechanism] +etaInfoAbs eis expr + | null eis = expr + | otherwise = case final_mco of + MRefl -> expr' + MCo co -> mkCast expr' co + where + (expr', final_mco) = foldr do_one (split_cast expr) eis + + do_one :: EtaInfo -> (CoreExpr, MCoercion) -> (CoreExpr, MCoercion) + -- Implements the "Abstraction" column in the comments for data EtaInfo + -- In both argument and result the pair (e,mco) denotes (e |> mco) + do_one (EtaVar v) (expr, mco) = (Lam v expr, mkPiMCo v mco) + do_one (EtaCo co) (expr, mco) = (expr, mco `mkTransMCoL` mkSymCo co) + + split_cast :: CoreExpr -> (CoreExpr, MCoercion) + split_cast (Cast e co) = (e, MCo co) + split_cast e = (e, MRefl) + -- We could look in the body of lets, and the branches of a case + -- But then we would have to worry about whether the cast mentioned + -- any of the bound variables, which is tiresome. Later maybe. + -- Result: we may end up with + -- (\(x::Int). case x of { DEFAULT -> e1 |> co }) |> sym (->co) + -- and fail to optimise it away -------------- -etaInfoApp :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr +etaInfoApp :: InScopeSet -> CoreExpr -> [EtaInfo] -> CoreExpr -- (etaInfoApp s e eis) returns something equivalent to --- ((substExpr s e) `appliedto` eis) - -etaInfoApp subst (Lam v1 e) (EtaVar v2 : eis) - = etaInfoApp (GHC.Core.Subst.extendSubstWithVar subst v1 v2) e eis - -etaInfoApp subst (Cast e co1) eis - = etaInfoApp subst e (pushCoercion co' eis) - where - co' = GHC.Core.Subst.substCo subst co1 +-- (substExpr s e `appliedto` eis) +-- See Note [The EtaInfo mechanism] -etaInfoApp subst (Case e b ty alts) eis - = Case (subst_expr subst e) b1 ty' alts' +etaInfoApp in_scope expr eis + = go (mkEmptySubst in_scope) expr eis where - (subst1, b1) = substBndr subst b - alts' = map subst_alt alts - ty' = etaInfoAppTy (GHC.Core.Subst.substTy subst ty) eis - subst_alt (con, bs, rhs) = (con, bs', etaInfoApp subst2 rhs eis) - where - (subst2,bs') = substBndrs subst1 bs - -etaInfoApp subst (Let b e) eis - | not (isJoinBind b) - -- See Note [Eta expansion for join points] - = Let b' (etaInfoApp subst' e eis) - where - (subst', b') = substBindSC subst b + go :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr + -- 'go' pushed down the eta-infos into the branch of a case + -- and the body of a let; and does beta-reduction if possible + go subst (Tick t e) eis + = Tick (substTickish subst t) (go subst e eis) + go subst (Cast e co) eis + = go subst e (pushCoercion (Core.substCo subst co) eis) + go subst (Case e b ty alts) eis + = Case (Core.substExprSC subst e) b1 ty' alts' + where + (subst1, b1) = Core.substBndr subst b + alts' = map subst_alt alts + ty' = etaInfoAppTy (Core.substTy subst ty) eis + subst_alt (con, bs, rhs) = (con, bs', go subst2 rhs eis) + where + (subst2,bs') = Core.substBndrs subst1 bs + go subst (Let b e) eis + | not (isJoinBind b) -- See Note [Eta expansion for join points] + = Let b' (go subst' e eis) + where + (subst', b') = Core.substBindSC subst b -etaInfoApp subst (Tick t e) eis - = Tick (substTickish subst t) (etaInfoApp subst e eis) + -- Beta-reduction if possible, using getArg_maybe to push + -- any intervening casts past the argument + -- See Note [The EtaInfo mechansim] + go subst (Lam v e) eis + | Just (arg, eis') <- getArg_maybe eis + = go (Core.extendSubst subst v arg) e eis' -etaInfoApp subst expr _ - | (Var fun, _) <- collectArgs expr - , Var fun' <- lookupIdSubst subst fun - , isJoinId fun' - = subst_expr subst expr + -- Stop pushing down; just wrap the expression up + go subst e eis = wrap (Core.substExprSC subst e) eis -etaInfoApp subst e eis - = go (subst_expr subst e) eis - where - go e [] = e - go e (EtaVar v : eis) = go (App e (varToCoreExpr v)) eis - go e (EtaCo co : eis) = go (Cast e co) eis + wrap e [] = e + wrap e (EtaVar v : eis) = wrap (App e (varToCoreExpr v)) eis + wrap e (EtaCo co : eis) = wrap (Cast e co) eis -------------- @@ -1235,7 +1370,7 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty -- We want to get -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x) | Just (co, ty') <- topNormaliseNewType_maybe ty - , let co' = Coercion.substCo subst co + , let co' = Type.substCo subst co -- Remember to apply the substitution to co (#16979) -- (or we could have applied to ty, but then -- we'd have had to zap it for the recursive call) @@ -1253,21 +1388,290 @@ mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty -- with an explicit lambda having a non-function type +{- ********************************************************************* +* * + The "push rules" +* * +************************************************************************ ------------- -subst_expr :: Subst -> CoreExpr -> CoreExpr --- Apply a substitution to an expression. We use substExpr --- not substExprSC (short-cutting substitution) because --- we may be changing the types of join points, so applying --- the in-scope set is necessary. +Here we implement the "push rules" from FC papers: + +* The push-argument rules, where we can move a coercion past an argument. + We have + (fun |> co) arg + and we want to transform it to + (fun arg') |> co' + for some suitable co' and transformed arg'. + +* The PushK rule for data constructors. We have + (K e1 .. en) |> co + and we want to transform to + (K e1' .. en') + by pushing the coercion into the arguments +-} + +pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion) +pushCoArgs co [] = return ([], MCo co) +pushCoArgs co (arg:args) = do { (arg', m_co1) <- pushCoArg co arg + ; case m_co1 of + MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args + ; return (arg':args', m_co2) } + MRefl -> return (arg':args, MRefl) } + +pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) +-- We have (fun |> co) arg, and we want to transform it to +-- (fun arg) |> co +-- This may fail, e.g. if (fun :: N) where N is a newtype +-- C.f. simplCast in GHC.Core.Opt.Simplify +-- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive +pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty + ; return (Type ty', m_co') } +pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co + ; return (val_arg `mkCastMCo` arg_co, m_co') } + +pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) +-- We have (fun |> co) @ty +-- Push the coercion through to return +-- (fun @ty') |> co' +-- 'co' is always Representational +-- If the returned coercion is Nothing, then it would have been reflexive; +-- it's faster not to compute it, though. +pushCoTyArg co ty + -- The following is inefficient - don't do `eqType` here, the coercion + -- optimizer will take care of it. See #14737. + -- -- | tyL `eqType` tyR + -- -- = Just (ty, Nothing) + + | isReflCo co + = Just (ty, MRefl) + + | isForAllTy_ty tyL + = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty ) + Just (ty `mkCastTy` co1, MCo co2) + + | otherwise + = Nothing + where + Pair tyL tyR = coercionKind co + -- co :: tyL ~ tyR + -- tyL = forall (a1 :: k1). ty1 + -- tyR = forall (a2 :: k2). ty2 + + co1 = mkSymCo (mkNthCo Nominal 0 co) + -- co1 :: k2 ~N k1 + -- Note that NthCo can extract a Nominal equality between the + -- kinds of the types related by a coercion between forall-types. + -- See the NthCo case in GHC.Core.Lint. + + co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) + -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] + -- Arg of mkInstCo is always nominal, hence mkNomReflCo + +pushCoValArg :: CoercionR -> Maybe (MCoercionR, MCoercionR) +-- We have (fun |> co) arg +-- Push the coercion through to return +-- (fun (arg |> co_arg)) |> co_res +-- 'co' is always Representational +-- If the second returned Coercion is actually Nothing, then no cast is necessary; +-- the returned coercion would have been reflexive. +pushCoValArg co + -- The following is inefficient - don't do `eqType` here, the coercion + -- optimizer will take care of it. See #14737. + -- -- | tyL `eqType` tyR + -- -- = Just (mkRepReflCo arg, Nothing) + + | isReflCo co + = Just (MRefl, MRefl) + + | isFunTy tyL + , (co_mult, co1, co2) <- decomposeFunCo Representational co + , isReflexiveCo co_mult + -- We can't push the coercion in the case where co_mult isn't reflexivity: + -- it could be an unsafe axiom, and losing this information could yield + -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) + -- with co :: (Int -> ()) ~ (Int #-> ()), would reduce to (fun x ::(1) Int + -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed + + -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) + -- then co1 :: tyL1 ~ tyR1 + -- co2 :: tyL2 ~ tyR2 + = ASSERT2( isFunTy tyR, ppr co $$ ppr arg ) + Just (coToMCo (mkSymCo co1), coToMCo co2) + -- Critically, coToMCo to checks for ReflCo; the whole coercion may not + -- be reflexive, but either of its components might be + -- We could use isReflexiveCo, but it's not clear if the benefit + -- is worth the cost, and it makes no difference in #18223 + + | otherwise + = Nothing + where + arg = funArgTy tyR + Pair tyL tyR = coercionKind co + +pushCoercionIntoLambda + :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) +-- This implements the Push rule from the paper on coercions +-- (\x. e) |> co +-- ===> +-- (\x'. e |> co') +pushCoercionIntoLambda in_scope x e co + | ASSERT(not (isTyVar x) && not (isCoVar x)) True + , Pair s1s2 t1t2 <- coercionKind co + , Just (_, _s1,_s2) <- splitFunTy_maybe s1s2 + , Just (w1, t1,_t2) <- splitFunTy_maybe t1t2 + , (co_mult, co1, co2) <- decomposeFunCo Representational co + , isReflexiveCo co_mult + -- We can't push the coercion in the case where co_mult isn't + -- reflexivity. See pushCoValArg for more details. + = let + -- Should we optimize the coercions here? + -- Otherwise they might not match too well + x' = x `setIdType` t1 `setIdMult` w1 + in_scope' = in_scope `extendInScopeSet` x' + subst = extendIdSubst (mkEmptySubst in_scope') + x + (mkCast (Var x') co1) + in Just (x', substExpr subst e `mkCast` co2) + | otherwise + = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e)) + Nothing + +pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion + -> Maybe (DataCon + , [Type] -- Universal type args + , [CoreExpr]) -- All other args incl existentials +-- Implement the KPush reduction rule as described in "Down with kinds" +-- The transformation applies iff we have +-- (C e1 ... en) `cast` co +-- where co :: (T t1 .. tn) ~ to_ty +-- The left-hand one must be a T, because exprIsConApp returned True +-- but the right-hand one might not be. (Though it usually will.) +pushCoDataCon dc dc_args co + | isReflCo co || from_ty `eqType` to_ty -- try cheap test first + , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args + = Just (dc, map exprToType univ_ty_args, rest_args) + + | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty + , to_tc == dataConTyCon dc + -- These two tests can fail; we might see + -- (C x y) `cast` (g :: T a ~ S [a]), + -- where S is a type function. In fact, exprIsConApp + -- will probably not be called in such circumstances, + -- but there's nothing wrong with it + + = let + tc_arity = tyConArity to_tc + dc_univ_tyvars = dataConUnivTyVars dc + dc_ex_tcvars = dataConExTyCoVars dc + arg_tys = dataConRepArgTys dc + + non_univ_args = dropList dc_univ_tyvars dc_args + (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args + + -- Make the "Psi" from the paper + omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) + (psi_subst, to_ex_arg_tys) + = liftCoSubstWithEx Representational + dc_univ_tyvars + omegas + dc_ex_tcvars + (map exprToType ex_args) + + -- Cast the value arguments (which include dictionaries) + new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args + cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) + + to_ex_args = map Type to_ex_arg_tys + + dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, + ppr arg_tys, ppr dc_args, + ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc + , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] + in + ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc ) + ASSERT2( equalLength val_args arg_tys, dump_doc ) + Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + + | otherwise + = Nothing + + where + Pair from_ty to_ty = coercionKind co + +collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) +-- Collect lambda binders, pushing coercions inside if possible +-- E.g. (\x.e) |> g g :: -> blah +-- = (\x. e |> Nth 1 g) +-- +-- That is, -- --- ToDo: we could instead check if we actually *are* --- changing any join points' types, and if not use substExprSC. -subst_expr = substExpr +-- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g) +collectBindersPushingCo e + = go [] e + where + -- Peel off lambdas until we hit a cast. + go :: [Var] -> CoreExpr -> ([Var], CoreExpr) + -- The accumulator is in reverse order + go bs (Lam b e) = go (b:bs) e + go bs (Cast e co) = go_c bs e co + go bs e = (reverse bs, e) + + -- We are in a cast; peel off casts until we hit a lambda. + go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr) + -- (go_c bs e c) is same as (go bs e (e |> c)) + go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2) + go_c bs (Lam b e) co = go_lam bs b e co + go_c bs e co = (reverse bs, mkCast e co) + + -- We are in a lambda under a cast; peel off lambdas and build a + -- new coercion for the body. + go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr) + -- (go_lam bs b e c) is same as (go_c bs (\b.e) c) + go_lam bs b e co + | isTyVar b + , let Pair tyL tyR = coercionKind co + , ASSERT( isForAllTy_ty tyL ) + isForAllTy_ty tyR + , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) + + | isCoVar b + , let Pair tyL tyR = coercionKind co + , ASSERT( isForAllTy_co tyL ) + isForAllTy_co tyR + , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] + , let cov = mkCoVarCo b + = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) + + | isId b + , let Pair tyL tyR = coercionKind co + , ASSERT( isFunTy tyL) isFunTy tyR + , (co_mult, co_arg, co_res) <- decomposeFunCo Representational co + , isReflCo co_mult -- See Note [collectBindersPushingCo] + , isReflCo co_arg -- See Note [collectBindersPushingCo] + = go_c (b:bs) e co_res + + | otherwise = (reverse bs, mkCast (Lam b e) co) +{- --------------- +Note [collectBindersPushingCo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We just look for coercions of form + # w -> blah +(and similarly for foralls) to keep this function simple. We could do +more elaborate stuff, but it'd involve substitution etc. + +-} + +{- ********************************************************************* +* * + Join points +* * +********************************************************************* -} +------------------- -- | Split an expression into the given number of binders and a body, -- eta-expanding if necessary. Counts value *and* type binders. etaExpandToJoinPoint :: JoinArity -> CoreExpr -> ([CoreBndr], CoreExpr) @@ -1307,7 +1711,7 @@ etaBodyForJoinPoint need_args body = (reverse rev_bs, e) go n ty subst rev_bs e | Just (tv, res_ty) <- splitForAllTy_maybe ty - , let (subst', tv') = Type.substVarBndr subst tv + , let (subst', tv') = substVarBndr subst tv = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv') | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty , let (subst', b) = freshEtaId n subst (Scaled mult arg_ty) @@ -1318,6 +1722,8 @@ etaBodyForJoinPoint need_args body init_subst e = mkEmptyTCvSubst (mkInScopeSet (exprFreeVars e)) + + -------------- freshEtaId :: Int -> TCvSubst -> Scaled Type -> (TCvSubst, Id) -- Make a fresh Id, with specified type (after applying substitution) @@ -1336,3 +1742,4 @@ freshEtaId n subst ty -- "OrCoVar" since this can be used to eta-expand -- coercion abstractions subst' = extendTCvInScope subst eta_id' + ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -315,33 +315,38 @@ getCoreToDo dflags runWhen do_float_in CoreDoFloatInwards, + simplify "final", -- Final tidy-up + maybe_rule_check FinalPhase, + -------- After this we have -O2 passes ----------------- + -- None of them run with -O + -- Case-liberation for -O2. This should be after -- strictness analysis and the simplification which follows it. - runWhen liberate_case (CoreDoPasses [ - CoreLiberateCase, - simplify "post-liberate-case" - ]), -- Run the simplifier after LiberateCase to vastly - -- reduce the possibility of shadowing - -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr + runWhen liberate_case $ CoreDoPasses + [ CoreLiberateCase, simplify "post-liberate-case" ], + -- Run the simplifier after LiberateCase to vastly + -- reduce the possibility of shadowing + -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr - runWhen spec_constr CoreDoSpecConstr, + runWhen spec_constr $ CoreDoPasses + [ CoreDoSpecConstr, simplify "post-spec-constr"], + -- See Note [Simplify after SpecConstr] maybe_rule_check FinalPhase, - runWhen late_specialise - (CoreDoPasses [ CoreDoSpecialising - , simplify "post-late-spec"]), + runWhen late_specialise $ CoreDoPasses + [ CoreDoSpecialising, simplify "post-late-spec"], -- LiberateCase can yield new CSE opportunities because it peels -- off one layer of a recursive function (concretely, I saw this -- in wheel-sieve1), and I'm guessing that SpecConstr can too -- And CSE is a very cheap pass. So it seems worth doing here. - runWhen ((liberate_case || spec_constr) && cse) CoreCSE, + runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses + [ CoreCSE, simplify "post-final-cse" ], - -- Final clean-up simplification: - simplify "final", + --------- End of -O2 passes -------------- runWhen late_dmd_anal $ CoreDoPasses ( dmd_cpr_ww ++ [simplify "post-late-ww"] @@ -410,6 +415,27 @@ or with -O0. Two reasons: But watch out: list fusion can prevent floating. So use phase control to switch off those rules until after floating. +Note [Simplify after SpecConstr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want to run the simplifier after SpecConstr, and before late-Specialise, +for two reasons, both shown up in test perf/compiler/T16473, +with -O2 -flate-specialise + +1. I found that running late-Specialise after SpecConstr, with no + simplification in between meant that the carefullly constructed + SpecConstr rule never got to fire. (It was something like + lvl = f a -- Arity 1 + ....g lvl.... + SpecConstr specialised g for argument lvl; but Specialise then + specialised lvl = f a to lvl = $sf, and inlined. Or something like + that.) + +2. Specialise relies on unfoldings being available for top-level dictionary + bindings; but SpecConstr kills them all! The Simplifer restores them. + +This extra run of the simplifier has a cost, but this is only with -O2. + + ************************************************************************ * * The CoreToDo interpreter ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -51,9 +51,9 @@ import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType + , pushCoTyArg, pushCoValArg , idArityType, etaExpandAT ) -import GHC.Core.SimpleOpt ( pushCoTyArg, pushCoValArg - , joinPointBinding_maybe, joinPointBindings_maybe ) +import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) import GHC.Types.Basic @@ -318,7 +318,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se ; let rhs_cont = mkRhsStop (substTy body_env (exprType body)) ; (body_floats0, body0) <- {-#SCC "simplExprF" #-} simplExprF body_env body rhs_cont - -- Never float join-floats out of a non-join let-binding + -- Never float join-floats out of a non-join let-binding (which this is) -- So wrap the body in the join-floats right now -- Hence: body_floats1 consists only of let-floats ; let (body_floats1, body1) = wrapJoinFloatsX body_floats0 body0 @@ -1414,25 +1414,23 @@ simplCast env body co0 cont0 -- type of the hole changes (#16312) -- (f |> co) e ===> (f (e |> co1)) |> co2 - -- where co :: (s1->s2) ~ (t1~t2) + -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 -- co2 :: s2 ~ t2 addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup, sc_cont = tail }) - | Just (co1, m_co2) <- pushCoValArg co - , let new_ty = coercionRKind co1 - , not (isTypeLevPoly new_ty) -- Without this check, we get a lev-poly arg - -- See Note [Levity polymorphism invariants] in GHC.Core - -- test: typecheck/should_run/EtaExpandLevPoly + | Just (m_co1, m_co2) <- pushCoValArg co + , levity_ok m_co1 = {-#SCC "addCoerce-pushCoValArg" #-} do { tail' <- addCoerceM m_co2 tail - ; if isReflCo co1 - then return (cont { sc_cont = tail' - , sc_hole_ty = coercionLKind co }) + ; case m_co1 of { + MRefl -> return (cont { sc_cont = tail' + , sc_hole_ty = coercionLKind co }) ; -- Avoid simplifying if possible; -- See Note [Avoiding exponential behaviour] - else do - { (dup', arg_se', arg') <- simplArg env dup arg_se arg + + MCo co1 -> + do { (dup', arg_se', arg') <- simplArg env dup arg_se arg -- When we build the ApplyTo we can't mix the OutCoercion -- 'co' with the InExpr 'arg', so we simplify -- to make it all consistent. It's a bit messy. @@ -1442,7 +1440,7 @@ simplCast env body co0 cont0 , sc_env = arg_se' , sc_dup = dup' , sc_cont = tail' - , sc_hole_ty = coercionLKind co }) } } + , sc_hole_ty = coercionLKind co }) } } } addCoerce co cont | isReflexiveCo co = return cont -- Having this at the end makes a huge @@ -1450,6 +1448,13 @@ simplCast env body co0 cont0 -- See Note [Optimising reflexivity] | otherwise = return (CastIt co cont) + levity_ok :: MCoercionR -> Bool + levity_ok MRefl = True + levity_ok (MCo co) = not $ isTypeLevPoly $ coercionRKind co + -- Without this check, we get a lev-poly arg + -- See Note [Levity polymorphism invariants] in GHC.Core + -- test: typecheck/should_run/EtaExpandLevPoly + simplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr -> SimplM (DupFlag, StaticEnv, OutExpr) simplArg env dup_flag arg_env arg @@ -3114,7 +3119,7 @@ knownCon :: SimplEnv knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont = do { (floats1, env1) <- bind_args env bs dc_args - ; (floats2, env2) <- bind_case_bndr env1 + ; (floats2, env2) <- bind_case_bndr env1 ; (floats3, expr') <- simplExprF env2 rhs cont ; case dc_floats of [] -> @@ -3240,6 +3245,7 @@ altsWouldDup [_] = False altsWouldDup (alt:alts) | is_bot_alt alt = altsWouldDup alts | otherwise = not (all is_bot_alt alts) + -- otherwise case: first alt is non-bot, so all the rest must be bot where is_bot_alt (_,_,rhs) = exprIsDeadEnd rhs ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -596,7 +596,7 @@ addJoinFlts :: JoinFloats -> JoinFloats -> JoinFloats addJoinFlts = appOL mkRecFloats :: SimplFloats -> SimplFloats --- Flattens the floats from env2 into a single Rec group, +-- Flattens the floats into a single Rec group, -- They must either all be lifted LetFloats or all JoinFloats mkRecFloats floats@(SimplFloats { sfLetFloats = LetFloats bs ff , sfJoinFloats = jbs ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -21,22 +21,21 @@ import GHC.Tc.Utils.TcType hiding( substTy ) import GHC.Core.Type hiding( substTy, extendTvSubstList ) import GHC.Core.Multiplicity import GHC.Core.Predicate -import GHC.Unit.Module( Module, HasModule(..) ) +import GHC.Unit.Module( Module ) import GHC.Core.Coercion( Coercion ) import GHC.Core.Opt.Monad import qualified GHC.Core.Subst as Core -import GHC.Core.Unfold import GHC.Core.Unfold.Make import GHC.Types.Var ( isLocalVar ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core import GHC.Core.Rules -import GHC.Core.SimpleOpt ( collectBindersPushingCo ) import GHC.Core.Utils ( exprIsTrivial, getIdFromTrivialExpr_maybe , mkCast, exprType ) import GHC.Core.FVs -import GHC.Core.Opt.Arity ( etaExpandToJoinPointRule ) +import GHC.Core.Opt.Arity ( collectBindersPushingCo + , etaExpandToJoinPointRule ) import GHC.Types.Unique.Supply import GHC.Types.Name import GHC.Types.Id.Make ( voidArgId, voidPrimId ) @@ -53,12 +52,9 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Utils.Monad.State import GHC.Types.Unique.DFM import GHC.Core.TyCo.Rep (TyCoBinder (..)) -import Control.Monad - {- ************************************************************************ * * @@ -592,28 +588,29 @@ specProgram guts@(ModGuts { mg_module = this_mod , mg_binds = binds }) = do { dflags <- getDynFlags + -- We need to start with a Subst that knows all the things + -- that are in scope, so that the substitution engine doesn't + -- accidentally re-use a unique that's already in use + -- Easiest thing is to do it all at once, as if all the top-level + -- decls were mutually recursive + ; let top_env = SE { se_subst = Core.mkEmptySubst $ mkInScopeSet $ mkVarSet $ + bindersOfBinds binds + , se_interesting = emptyVarSet + , se_module = this_mod + , se_dflags = dflags } + + go [] = return ([], emptyUDs) + go (bind:binds) = do (binds', uds) <- go binds + (bind', uds') <- specBind top_env bind uds + return (bind' ++ binds', uds') + -- Specialise the bindings of this module - ; (binds', uds) <- runSpecM dflags this_mod (go binds) + ; (binds', uds) <- runSpecM (go binds) - ; (spec_rules, spec_binds) <- specImports dflags this_mod top_env - local_rules uds + ; (spec_rules, spec_binds) <- specImports top_env local_rules uds ; return (guts { mg_binds = spec_binds ++ binds' , mg_rules = spec_rules ++ local_rules }) } - where - -- We need to start with a Subst that knows all the things - -- that are in scope, so that the substitution engine doesn't - -- accidentally re-use a unique that's already in use - -- Easiest thing is to do it all at once, as if all the top-level - -- decls were mutually recursive - top_env = SE { se_subst = Core.mkEmptySubst $ mkInScopeSet $ mkVarSet $ - bindersOfBinds binds - , se_interesting = emptyVarSet } - - go [] = return ([], emptyUDs) - go (bind:binds) = do (binds', uds) <- go binds - (bind', uds') <- specBind top_env bind uds - return (bind' ++ binds', uds') {- Note [Wrap bindings returned by specImports] @@ -643,13 +640,13 @@ See #10491 * * ********************************************************************* -} -specImports :: DynFlags -> Module -> SpecEnv +specImports :: SpecEnv -> [CoreRule] -> UsageDetails -> CoreM ([CoreRule], [CoreBind]) -specImports dflags this_mod top_env local_rules +specImports top_env local_rules (MkUD { ud_binds = dict_binds, ud_calls = calls }) - | not $ gopt Opt_CrossModuleSpecialise dflags + | not $ gopt Opt_CrossModuleSpecialise (se_dflags top_env) -- See Note [Disabling cross-module specialisation] = return ([], wrapDictBinds dict_binds []) @@ -657,8 +654,7 @@ specImports dflags this_mod top_env local_rules = do { hpt_rules <- getRuleBase ; let rule_base = extendRuleBaseList hpt_rules local_rules - ; (spec_rules, spec_binds) <- spec_imports dflags this_mod top_env - [] rule_base + ; (spec_rules, spec_binds) <- spec_imports top_env [] rule_base dict_binds calls -- Don't forget to wrap the specialized bindings with @@ -674,9 +670,7 @@ specImports dflags this_mod top_env local_rules } -- | Specialise a set of calls to imported bindings -spec_imports :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope +spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in scope -> [Id] -- Stack of imported functions being specialised -- See Note [specImport call stack] -> RuleBase -- Rules from this module and the home package @@ -686,8 +680,7 @@ spec_imports :: DynFlags -> CallDetails -- Calls for imported things -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings -spec_imports dflags this_mod top_env - callers rule_base dict_binds calls +spec_imports top_env callers rule_base dict_binds calls = do { let import_calls = dVarEnvElts calls -- ; debugTraceMsg (text "specImports {" <+> -- vcat [ text "calls:" <+> ppr import_calls @@ -701,16 +694,13 @@ spec_imports dflags this_mod top_env go _ [] = return ([], []) go rb (cis : other_calls) = do { -- debugTraceMsg (text "specImport {" <+> ppr cis) - ; (rules1, spec_binds1) <- spec_import dflags this_mod top_env - callers rb dict_binds cis + ; (rules1, spec_binds1) <- spec_import top_env callers rb dict_binds cis -- ; debugTraceMsg (text "specImport }" <+> ppr cis) ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) } -spec_import :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope +spec_import :: SpecEnv -- Passed in so that all top-level Ids are in scope -> [Id] -- Stack of imported functions being specialised -- See Note [specImport call stack] -> RuleBase -- Rules from this module @@ -719,8 +709,7 @@ spec_import :: DynFlags -> CallInfoSet -- Imported function and calls for it -> CoreM ( [CoreRule] -- New rules , [CoreBind] ) -- Specialised bindings -spec_import dflags this_mod top_env callers - rb dict_binds cis@(CIS fn _) +spec_import top_env callers rb dict_binds cis@(CIS fn _) | isIn "specImport" fn callers = return ([], []) -- No warning. This actually happens all the time -- when specialising a recursive function, because @@ -731,8 +720,7 @@ spec_import dflags this_mod top_env callers = do { -- debugTraceMsg (text "specImport:no valid calls") ; return ([], []) } - | wantSpecImport dflags unfolding - , Just rhs <- maybeUnfoldingTemplate unfolding + | Just rhs <- canSpecImport dflags fn = do { -- Get rules from the external package state -- We keep doing this in case we "page-fault in" -- more rules as we go along @@ -744,8 +732,8 @@ spec_import dflags this_mod top_env callers ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) <- do { -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs]) - ; runSpecM dflags this_mod $ - specCalls (Just this_mod) top_env rules_for_fn good_calls fn rhs } + ; runSpecM $ + specCalls True top_env rules_for_fn good_calls fn rhs } ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs] -- After the rules kick in we may get recursion, but -- we rely on a global GlomBinds to sort that out later @@ -753,7 +741,7 @@ spec_import dflags this_mod top_env callers -- Now specialise any cascaded calls -- ; debugTraceMsg (text "specImport 2" <+> (ppr fn $$ ppr rules1 $$ ppr spec_binds1)) - ; (rules2, spec_binds2) <- spec_imports dflags this_mod top_env + ; (rules2, spec_binds2) <- spec_imports top_env (fn:callers) (extendRuleBaseList rb rules1) (dict_binds `unionBags` dict_binds1) @@ -769,11 +757,34 @@ spec_import dflags this_mod top_env callers ; return ([], [])} where - unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + dflags = se_dflags top_env good_calls = filterCalls cis dict_binds -- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn -- See Note [Avoiding loops in specImports] +canSpecImport :: DynFlags -> Id -> Maybe CoreExpr +-- See Note [Specialise imported INLINABLE things] +canSpecImport dflags fn + | CoreUnfolding { uf_src = src, uf_tmpl = rhs } <- unf + , isStableSource src + = Just rhs -- By default, specialise only imported things that have a stable + -- unfolding; that is, have an INLINE or INLINABLE pragma + -- Specialise even INLINE things; it hasn't inlined yet, + -- so perhaps it never will. Moreover it may have calls + -- inside it that we want to specialise + + -- CoreUnfolding case does /not/ include DFunUnfoldings; + -- We only specialise DFunUnfoldings with -fspecialise-aggressively + -- See Note [Do not specialise imported DFuns] + + | gopt Opt_SpecialiseAggressively dflags + = maybeUnfoldingTemplate unf -- With -fspecialise-aggressively, specialise anything + -- with an unfolding, stable or not, DFun or not + + | otherwise = Nothing + where + unf = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + -- | Returns whether or not to show a missed-spec warning. -- If -Wall-missed-specializations is on, show the warning. -- Otherwise, if -Wmissed-specializations is on, only show a warning @@ -798,24 +809,47 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ]) -wantSpecImport :: DynFlags -> Unfolding -> Bool --- See Note [Specialise imported INLINABLE things] -wantSpecImport dflags unf - = case unf of - NoUnfolding -> False - BootUnfolding -> False - OtherCon {} -> False - DFunUnfolding {} -> True - CoreUnfolding { uf_src = src, uf_guidance = _guidance } - | gopt Opt_SpecialiseAggressively dflags -> True - | isStableSource src -> True - -- Specialise even INLINE things; it hasn't inlined yet, - -- so perhaps it never will. Moreover it may have calls - -- inside it that we want to specialise - | otherwise -> False -- Stable, not INLINE, hence INLINABLE -{- Note [Avoiding loops in specImports] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +{- Note [Do not specialise imported DFuns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticket #18223 shows that specialising calls of DFuns is can cause a huge +and entirely unnecessary blowup in program size. Consider a call to + f @[[[[[[[[T]]]]]]]] d1 x +where df :: C a => C [a] + d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1 + d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3 + ... +Now we'll specialise f's RHS, which may give rise to calls to 'g', +also overloaded, which we will specialise, and so on. However, if +we specialise the calls to dfC[], we'll generate specialised copies of +all methods of C, at all types; and the same for C's superclasses. + +And many of these specialised functions will never be called. We are +going to call the specialised 'f', and the specialised 'g', but DFuns +group functions into a tuple, many of whose elements may never be used. + +With deeply-nested types this can lead to a simply overwhelming number +of specialisations: see #18223 for a simple example (from the wild). +I measured the number of specialisations for various numbers of calls +of `flip evalStateT ()`, and got this + + Size after one simplification + #calls #SPEC rules Terms Types + 5 56 3100 10600 + 9 108 13660 77206 + +The real tests case has 60+ calls, which blew GHC out of the water. + +Solution: don't specialise DFuns. The downside is that if we end +up with (h (dfun d)), /and/ we don't specialise 'h', then we won't +pass to 'h' a tuple of specialised functions. + +However, the flag -fspecialise-aggressively (experimental, off by default) +allows DFuns to specialise as well. + +Note [Avoiding loops in specImports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We must take great care when specialising instance declarations (functions like $fOrdList) lest we accidentally build a recursive dictionary. See Note [Avoiding loops]. @@ -1003,6 +1037,9 @@ data SpecEnv -- Dict Ids that we know something about -- and hence may be worth specialising against -- See Note [Interesting dictionary arguments] + + , se_module :: Module + , se_dflags :: DynFlags } instance Outputable SpecEnv where @@ -1310,7 +1347,7 @@ specDefn :: SpecEnv specDefn env body_uds fn rhs = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds rules_for_me = idCoreRules fn - ; (rules, spec_defns, spec_uds) <- specCalls Nothing env rules_for_me + ; (rules, spec_defns, spec_uds) <- specCalls False env rules_for_me calls_for_me fn rhs ; return ( fn `addIdSpecialisations` rules , spec_defns @@ -1323,8 +1360,8 @@ specDefn env body_uds fn rhs -- body_uds_without_me --------------------------- -specCalls :: Maybe Module -- Just this_mod => specialising imported fn - -- Nothing => specialising local fn +specCalls :: Bool -- True => specialising imported fn + -- False => specialising local fn -> SpecEnv -> [CoreRule] -- Existing RULES for the fn -> [CallInfo] @@ -1339,7 +1376,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules , [(Id,CoreExpr)] -- Specialised definition , UsageDetails ) -- Usage details from specialised RHSs -specCalls mb_mod env existing_rules calls_for_me fn rhs +specCalls spec_imp env existing_rules calls_for_me fn rhs -- The first case is the interesting one | notNull calls_for_me -- And there are some calls to specialise && not (isNeverActive (idInlineActivation fn)) @@ -1370,7 +1407,9 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs inl_act = inlinePragmaActivation inl_prag is_local = isLocalId fn is_dfun = isDFunId fn - + dflags = se_dflags env + ropts = initRuleOpts dflags + this_mod = se_module env -- Figure out whether the function has an INLINE pragma -- See Note [Inline specialisations] @@ -1412,8 +1451,6 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs -- , ppr dx_binds ]) $ -- return () - ; dflags <- getDynFlags - ; let ropts = initRuleOpts dflags ; if not useful -- No useful specialisation || already_covered ropts rules_acc rule_lhs_args then return spec_acc @@ -1441,17 +1478,15 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs = Nothing ; spec_fn <- newSpecIdSM fn spec_fn_ty spec_join_arity - ; this_mod <- getModule ; let -- The rule to put in the function's specialisation is: -- forall x @b d1' d2'. -- f x @T1 @b @T2 d1' d2' = f1 x @b -- See Note [Specialising Calls] - herald = case mb_mod of - Nothing -- Specialising local fn - -> text "SPEC" - Just this_mod -- Specialising imported fn - -> text "SPEC/" <> ppr this_mod + herald | spec_imp = -- Specialising imported fn + text "SPEC/" <> ppr this_mod + | otherwise = -- Specialising local fn + text "SPEC" rule_name = mkFastString $ showSDoc dflags $ herald <+> ftext (occNameFS (getOccName fn)) @@ -2480,15 +2515,15 @@ mkCallUDs env f args res = mkCallUDs' env f args mkCallUDs' env f args - | not (want_calls_for f) -- Imported from elsewhere - || null ci_key -- No useful specialisation - -- See also Note [Specialisations already covered] + | wantCallsFor env f -- We want it, and... + , not (null ci_key) -- this call site has a useful specialisation + = -- pprTrace "mkCallUDs: keeping" _trace_doc + singleCall f ci_key + + | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc emptyUDs - | otherwise - = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key where _trace_doc = vcat [ppr f, ppr args, ppr ci_key] pis = fst $ splitPiTys $ idType f @@ -2525,12 +2560,23 @@ mkCallUDs' env f args mk_spec_arg _ (Anon VisArg _) = UnspecArg - want_calls_for f = isLocalId f || isJust (maybeUnfoldingTemplate (realIdUnfolding f)) - -- For imported things, we gather call instances if - -- there is an unfolding that we could in principle specialise - -- We might still decide not to use it (consulting dflags) - -- in specImports - -- Use 'realIdUnfolding' to ignore the loop-breaker flag! +wantCallsFor :: SpecEnv -> Id -> Bool +wantCallsFor _env _f = True + -- We could reduce the size of the UsageDetails by being less eager + -- about collecting calls for LocalIds: there is no point for + -- ones that are lambda-bound. We can't decide this by looking at + -- the (absence of an) unfolding, because unfoldings for local + -- functions are discarded by cloneBindSM, so no local binder will + -- have an unfolding at this stage. We'd have to keep a candidate + -- set of let-binders. + -- + -- Not many lambda-bound variables have dictionary arguments, so + -- this would make little difference anyway. + -- + -- For imported Ids we could check for an unfolding, but we have to + -- do so anyway in canSpecImport, and it seems better to have it + -- all in one place. So we simply collect usage info for imported + -- overloaded functions. {- Note [Type determines value] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2780,55 +2826,12 @@ deleteCallsFor bs calls = delDVarEnvList calls bs ************************************************************************ -} -newtype SpecM a = SpecM (State SpecState a) deriving (Functor) - -data SpecState = SpecState { - spec_uniq_supply :: UniqSupply, - spec_module :: Module, - spec_dflags :: DynFlags - } - -instance Applicative SpecM where - pure x = SpecM $ return x - (<*>) = ap - -instance Monad SpecM where - SpecM x >>= f = SpecM $ do y <- x - case f y of - SpecM z -> - z - -instance MonadFail SpecM where - fail str = SpecM $ error str - -instance MonadUnique SpecM where - getUniqueSupplyM - = SpecM $ do st <- get - let (us1, us2) = splitUniqSupply $ spec_uniq_supply st - put $ st { spec_uniq_supply = us2 } - return us1 - - getUniqueM - = SpecM $ do st <- get - let (u,us') = takeUniqFromSupply $ spec_uniq_supply st - put $ st { spec_uniq_supply = us' } - return u - -instance HasDynFlags SpecM where - getDynFlags = SpecM $ liftM spec_dflags get - -instance HasModule SpecM where - getModule = SpecM $ liftM spec_module get - -runSpecM :: DynFlags -> Module -> SpecM a -> CoreM a -runSpecM dflags this_mod (SpecM spec) - = do us <- getUniqueSupplyM - let initialState = SpecState { - spec_uniq_supply = us, - spec_module = this_mod, - spec_dflags = dflags - } - return $ evalState spec initialState +type SpecM a = UniqSM a + +runSpecM :: SpecM a -> CoreM a +runSpecM thing_inside + = do { us <- getUniqueSupplyM + ; return (initUs_ us thing_inside) } mapAndCombineSM :: (a -> SpecM (b, UsageDetails)) -> [a] -> SpecM ([b], UsageDetails) mapAndCombineSM _ [] = return ([], emptyUDs) ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -161,15 +161,20 @@ pprOptCo co = sdocOption sdocSuppressCoercions $ \case True -> angleBrackets (text "Co:" <> int (coercionSize co)) False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)] +ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc +ppr_id_occ add_par id + | isJoinId id = add_par ((text "jump") <+> pp_id) + | otherwise = pp_id + where + pp_id = ppr id -- We could use pprPrefixOcc to print (+) etc, but this is + -- Core where we don't print things infix anyway, so doing + -- so just adds extra redundant parens + ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc -- The function adds parens in context that need -- an atomic value (e.g. function args) -ppr_expr add_par (Var name) - | isJoinId name = add_par ((text "jump") <+> pp_name) - | otherwise = pp_name - where - pp_name = pprPrefixOcc name +ppr_expr add_par (Var id) = ppr_id_occ add_par id ppr_expr add_par (Type ty) = add_par (text "TYPE:" <+> ppr ty) -- Weird ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co) ppr_expr add_par (Lit lit) = pprLiteral add_par lit @@ -212,8 +217,7 @@ ppr_expr add_par expr@(App {}) _ -> parens (hang fun_doc 2 pp_args) where - fun_doc | isJoinId f = text "jump" <+> ppr f - | otherwise = ppr f + fun_doc = ppr_id_occ noParens f _ -> parens (hang (pprParendExpr fun) 2 pp_args) } ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -18,17 +18,14 @@ module GHC.Core.SimpleOpt ( -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, - -- ** Coercions and casts - pushCoArg, pushCoValArg, pushCoTyArg, collectBindersPushingCo ) where #include "HsVersions.h" import GHC.Prelude -import GHC.Core.Opt.Arity( etaExpandToJoinPoint ) - import GHC.Core +import GHC.Core.Opt.Arity import GHC.Core.Subst import GHC.Core.Utils import GHC.Core.FVs @@ -48,16 +45,12 @@ import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) -import GHC.Core.TyCon ( tyConArity ) -import GHC.Core.Multiplicity import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Types.Basic import GHC.Unit.Module ( Module ) -import GHC.Driver.Ppr import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Data.Pair import GHC.Utils.Misc import GHC.Data.Maybe ( orElse ) import GHC.Data.FastString @@ -782,6 +775,28 @@ a good cause. And it won't hurt other RULES and such that it comes across. ************************************************************************ -} +{- Note [Strictness and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + + let f = \x. if x>200 then e1 else e1 + +and we know that f is strict in x. Then if we subsequently +discover that f is an arity-2 join point, we'll eta-expand it to + + let f = \x y. if x>200 then e1 else e1 + +and now it's only strict if applied to two arguments. So we should +adjust the strictness info. + +A more common case is when + + f = \x. error ".." + +and again its arity increases (#15517) +-} + + -- | Returns Just (bndr,rhs) if the binding is a join point: -- If it's a JoinId, just return it -- If it's not yet a JoinId but is always tail-called, @@ -815,27 +830,6 @@ joinPointBindings_maybe bndrs = mapM (uncurry joinPointBinding_maybe) bndrs -{- Note [Strictness and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - let f = \x. if x>200 then e1 else e1 - -and we know that f is strict in x. Then if we subsequently -discover that f is an arity-2 join point, we'll eta-expand it to - - let f = \x y. if x>200 then e1 else e1 - -and now it's only strict if applied to two arguments. So we should -adjust the strictness info. - -A more common case is when - - f = \x. error ".." - -and again its arity increases (#15517) --} - {- ********************************************************************* * * exprIsConApp_maybe @@ -1350,275 +1344,3 @@ exprIsLambda_maybe _ _e Nothing -{- ********************************************************************* -* * - The "push rules" -* * -************************************************************************ - -Here we implement the "push rules" from FC papers: - -* The push-argument rules, where we can move a coercion past an argument. - We have - (fun |> co) arg - and we want to transform it to - (fun arg') |> co' - for some suitable co' and transformed arg'. - -* The PushK rule for data constructors. We have - (K e1 .. en) |> co - and we want to transform to - (K e1' .. en') - by pushing the coercion into the arguments --} - -pushCoArgs :: CoercionR -> [CoreArg] -> Maybe ([CoreArg], MCoercion) -pushCoArgs co [] = return ([], MCo co) -pushCoArgs co (arg:args) = do { (arg', m_co1) <- pushCoArg co arg - ; case m_co1 of - MCo co1 -> do { (args', m_co2) <- pushCoArgs co1 args - ; return (arg':args', m_co2) } - MRefl -> return (arg':args, MRefl) } - -pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) --- We have (fun |> co) arg, and we want to transform it to --- (fun arg) |> co --- This may fail, e.g. if (fun :: N) where N is a newtype --- C.f. simplCast in GHC.Core.Opt.Simplify --- 'co' is always Representational --- If the returned coercion is Nothing, then it would have been reflexive -pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty - ; return (Type ty', m_co') } -pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co - ; return (val_arg `mkCast` arg_co, m_co') } - -pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) --- We have (fun |> co) @ty --- Push the coercion through to return --- (fun @ty') |> co' --- 'co' is always Representational --- If the returned coercion is Nothing, then it would have been reflexive; --- it's faster not to compute it, though. -pushCoTyArg co ty - -- The following is inefficient - don't do `eqType` here, the coercion - -- optimizer will take care of it. See #14737. - -- -- | tyL `eqType` tyR - -- -- = Just (ty, Nothing) - - | isReflCo co - = Just (ty, MRefl) - - | isForAllTy_ty tyL - = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty ) - Just (ty `mkCastTy` co1, MCo co2) - - | otherwise - = Nothing - where - Pair tyL tyR = coercionKind co - -- co :: tyL ~ tyR - -- tyL = forall (a1 :: k1). ty1 - -- tyR = forall (a2 :: k2). ty2 - - co1 = mkSymCo (mkNthCo Nominal 0 co) - -- co1 :: k2 ~N k1 - -- Note that NthCo can extract a Nominal equality between the - -- kinds of the types related by a coercion between forall-types. - -- See the NthCo case in GHC.Core.Lint. - - co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) - -- co2 :: ty1[ (ty|>co1)/a1 ] ~ ty2[ ty/a2 ] - -- Arg of mkInstCo is always nominal, hence mkNomReflCo - -pushCoValArg :: CoercionR -> Maybe (Coercion, MCoercion) --- We have (fun |> co) arg --- Push the coercion through to return --- (fun (arg |> co_arg)) |> co_res --- 'co' is always Representational --- If the second returned Coercion is actually Nothing, then no cast is necessary; --- the returned coercion would have been reflexive. -pushCoValArg co - -- The following is inefficient - don't do `eqType` here, the coercion - -- optimizer will take care of it. See #14737. - -- -- | tyL `eqType` tyR - -- -- = Just (mkRepReflCo arg, Nothing) - - | isReflCo co - = Just (mkRepReflCo arg, MRefl) - - | isFunTy tyL - , (co_mult, co1, co2) <- decomposeFunCo Representational co - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't reflexivity: - -- it could be an unsafe axiom, and losing this information could yield - -- ill-typed terms. For instance (fun x ::(1) Int -> (fun _ -> () |> co) x) - -- with co :: (Int -> ()) ~ (Int #-> ()), would reduce to (fun x ::(1) Int - -- -> (fun _ ::(Many) Int -> ()) x) which is ill-typed - - -- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2) - -- then co1 :: tyL1 ~ tyR1 - -- co2 :: tyL2 ~ tyR2 - = ASSERT2( isFunTy tyR, ppr co $$ ppr arg ) - Just (mkSymCo co1, MCo co2) - - | otherwise - = Nothing - where - arg = funArgTy tyR - Pair tyL tyR = coercionKind co - -pushCoercionIntoLambda - :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) --- This implements the Push rule from the paper on coercions --- (\x. e) |> co --- ===> --- (\x'. e |> co') -pushCoercionIntoLambda in_scope x e co - | ASSERT(not (isTyVar x) && not (isCoVar x)) True - , Pair s1s2 t1t2 <- coercionKind co - , Just (_, _s1,_s2) <- splitFunTy_maybe s1s2 - , Just (w1, t1,_t2) <- splitFunTy_maybe t1t2 - , (co_mult, co1, co2) <- decomposeFunCo Representational co - , isReflexiveCo co_mult - -- We can't push the coercion in the case where co_mult isn't - -- reflexivity. See pushCoValArg for more details. - = let - -- Should we optimize the coercions here? - -- Otherwise they might not match too well - x' = x `setIdType` t1 `setIdMult` w1 - in_scope' = in_scope `extendInScopeSet` x' - subst = extendIdSubst (mkEmptySubst in_scope') - x - (mkCast (Var x') co1) - in Just (x', substExpr subst e `mkCast` co2) - | otherwise - = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e)) - Nothing - -pushCoDataCon :: DataCon -> [CoreExpr] -> Coercion - -> Maybe (DataCon - , [Type] -- Universal type args - , [CoreExpr]) -- All other args incl existentials --- Implement the KPush reduction rule as described in "Down with kinds" --- The transformation applies iff we have --- (C e1 ... en) `cast` co --- where co :: (T t1 .. tn) ~ to_ty --- The left-hand one must be a T, because exprIsConApp returned True --- but the right-hand one might not be. (Though it usually will.) -pushCoDataCon dc dc_args co - | isReflCo co || from_ty `eqType` to_ty -- try cheap test first - , let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args - = Just (dc, map exprToType univ_ty_args, rest_args) - - | Just (to_tc, to_tc_arg_tys) <- splitTyConApp_maybe to_ty - , to_tc == dataConTyCon dc - -- These two tests can fail; we might see - -- (C x y) `cast` (g :: T a ~ S [a]), - -- where S is a type function. In fact, exprIsConApp - -- will probably not be called in such circumstances, - -- but there's nothing wrong with it - - = let - tc_arity = tyConArity to_tc - dc_univ_tyvars = dataConUnivTyVars dc - dc_ex_tcvars = dataConExTyCoVars dc - arg_tys = dataConRepArgTys dc - - non_univ_args = dropList dc_univ_tyvars dc_args - (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args - - -- Make the "Psi" from the paper - omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) - (psi_subst, to_ex_arg_tys) - = liftCoSubstWithEx Representational - dc_univ_tyvars - omegas - dc_ex_tcvars - (map exprToType ex_args) - - -- Cast the value arguments (which include dictionaries) - new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args - cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) - - to_ex_args = map Type to_ex_arg_tys - - dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, - ppr arg_tys, ppr dc_args, - ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc - , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] - in - ASSERT2( eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args)), dump_doc ) - ASSERT2( equalLength val_args arg_tys, dump_doc ) - Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) - - | otherwise - = Nothing - - where - Pair from_ty to_ty = coercionKind co - -collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) --- Collect lambda binders, pushing coercions inside if possible --- E.g. (\x.e) |> g g :: -> blah --- = (\x. e |> Nth 1 g) --- --- That is, --- --- collectBindersPushingCo ((\x.e) |> g) === ([x], e |> Nth 1 g) -collectBindersPushingCo e - = go [] e - where - -- Peel off lambdas until we hit a cast. - go :: [Var] -> CoreExpr -> ([Var], CoreExpr) - -- The accumulator is in reverse order - go bs (Lam b e) = go (b:bs) e - go bs (Cast e co) = go_c bs e co - go bs e = (reverse bs, e) - - -- We are in a cast; peel off casts until we hit a lambda. - go_c :: [Var] -> CoreExpr -> CoercionR -> ([Var], CoreExpr) - -- (go_c bs e c) is same as (go bs e (e |> c)) - go_c bs (Cast e co1) co2 = go_c bs e (co1 `mkTransCo` co2) - go_c bs (Lam b e) co = go_lam bs b e co - go_c bs e co = (reverse bs, mkCast e co) - - -- We are in a lambda under a cast; peel off lambdas and build a - -- new coercion for the body. - go_lam :: [Var] -> Var -> CoreExpr -> CoercionR -> ([Var], CoreExpr) - -- (go_lam bs b e c) is same as (go_c bs (\b.e) c) - go_lam bs b e co - | isTyVar b - , let Pair tyL tyR = coercionKind co - , ASSERT( isForAllTy_ty tyL ) - isForAllTy_ty tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b))) - - | isCoVar b - , let Pair tyL tyR = coercionKind co - , ASSERT( isForAllTy_co tyL ) - isForAllTy_co tyR - , isReflCo (mkNthCo Nominal 0 co) -- See Note [collectBindersPushingCo] - , let cov = mkCoVarCo b - = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov))) - - | isId b - , let Pair tyL tyR = coercionKind co - , ASSERT( isFunTy tyL) isFunTy tyR - , (co_mult, co_arg, co_res) <- decomposeFunCo Representational co - , isReflCo co_mult -- See Note [collectBindersPushingCo] - , isReflCo co_arg -- See Note [collectBindersPushingCo] - = go_c (b:bs) e co_res - - | otherwise = (reverse bs, mkCast (Lam b e) co) - -{- - -Note [collectBindersPushingCo] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We just look for coercions of form - # w -> blah -(and similarly for foralls) to keep this function simple. We could do -more elaborate stuff, but it'd involve substitution etc. - --} ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -343,6 +343,8 @@ instance Outputable Subst where substExprSC :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr -- Just like substExpr, but a no-op if the substitution is empty +-- Note that this does /not/ replace occurrences of free vars with +-- their canonical representatives in the in-scope set substExprSC subst orig_expr | isEmptySubst subst = orig_expr | otherwise = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $ @@ -628,6 +630,9 @@ substIdInfo subst new_id info ------------------ -- | Substitutes for the 'Id's within an unfolding +-- NB: substUnfolding /discards/ any unfolding without +-- without a Stable source. This is usually what we want, +-- but it may be a bit unexpected substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding -- Seq'ing on the returned Unfolding is enough to cause -- all the substitutions to happen completely ===================================== testsuite/tests/perf/compiler/Makefile ===================================== @@ -7,7 +7,3 @@ T4007: $(RM) -f T4007.hi T4007.o '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T4007.hs -T16473: - $(RM) -f T16473.hi T16473.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-rule-firings T16473.hs - ===================================== testsuite/tests/perf/compiler/T16473.stdout ===================================== @@ -1,97 +1 @@ -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op liftA2 (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op <$ (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op get (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op >> (BUILTIN) -Rule fired: Class op put (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op get (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op >> (BUILTIN) -Rule fired: Class op put (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op show (BUILTIN) -Rule fired: Class op mempty (BUILTIN) -Rule fired: Class op fromInteger (BUILTIN) -Rule fired: Integer -> Int# (BUILTIN) -Rule fired: Class op <> (BUILTIN) -Rule fired: Class op + (BUILTIN) -Rule fired: Class op enumFromTo (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op *> (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: fold/build (GHC.Base) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: ># (BUILTIN) -Rule fired: ==# (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op <*> (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op pure (BUILTIN) -Rule fired: Class op $p1Monad (BUILTIN) -Rule fired: Class op $p1Applicative (BUILTIN) -Rule fired: SPEC/Main $fMonadStateT_$c>>= @Identity _ (Main) -Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @Identity _ (Main) -Rule fired: SPEC/Main $fApplicativeStateT_$cpure @Identity _ (Main) -Rule fired: SPEC/Main $fFunctorStateT @Identity _ (Main) -Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main) -Rule fired: Class op fmap (BUILTIN) -Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op fmap (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op return (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op >>= (BUILTIN) -Rule fired: Class op return (BUILTIN) +5050 ===================================== testsuite/tests/perf/compiler/T18223.hs ===================================== @@ -0,0 +1,78 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE Strict #-} + +import Control.Monad.State + +tester :: MonadState a m => m () +tester = modify' id + +-- manyState :: StateT () (StateT () IO) () -> IO () +-- manyState :: _ -> IO () +manyState x = + (flip evalStateT () -- 1 + . flip evalStateT () -- 2 + . flip evalStateT () -- 3 + . flip evalStateT () -- 4 + . flip evalStateT () -- 5 + . flip evalStateT () -- 6 + . flip evalStateT () -- 7 + . flip evalStateT () -- 8 + . flip evalStateT () -- 9 + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + . flip evalStateT () + ) x :: IO () + +main :: IO () +main = manyState tester >>= print ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -367,7 +367,13 @@ test('T16190', multimod_compile, ['T16190.hs', '-v0']) -test('T16473', normal, makefile_test, ['T16473']) +# Run this program. If specialisation fails, it'll start to allocate much more +test ('T16473', + [ collect_stats('bytes allocated',5) + , only_ways(['normal']) + ], + compile_and_run, + ['-O2 -flate-specialise']) test('T17516', [ collect_compiler_stats('bytes allocated', 5), @@ -415,3 +421,8 @@ test ('T13253-spj', ], compile, ['-v0 -O']) +test ('T18223', + [ collect_compiler_stats('bytes allocated',2) + ], + compile, + ['-v0 -O']) ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -20,7 +20,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} (+++) :: forall {a}. [a] -> [a] -> [a] [GblId] -(+++) = (++) +(+++) = ++ -- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0} T18052a.$m:||: ===================================== testsuite/tests/simplCore/should_compile/T17966.stdout ===================================== @@ -1,5 +1,2 @@ RULES: "SPEC $cm @()" [0] RULES: "SPEC f @Bool @() @(Maybe Integer)" [0] -"SPEC/T17966 $fShowMaybe_$cshow @Integer" -"SPEC/T17966 $fShowMaybe_$cshowList @Integer" -"SPEC/T17966 $fShowMaybe @Integer" ===================================== testsuite/tests/stranal/should_compile/T18122.stderr ===================================== @@ -13,9 +13,8 @@ Lib.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Lib.$trModule3 :: GHC.Types.TrName [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule3 = GHC.Types.TrNameS Lib.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} @@ -28,27 +27,25 @@ Lib.$trModule2 = "Lib"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} Lib.$trModule1 :: GHC.Types.TrName [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule1 = GHC.Types.TrNameS Lib.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Lib.$trModule :: GHC.Types.Module [GblId, - Cpr=m1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] Lib.$trModule = GHC.Types.Module Lib.$trModule3 Lib.$trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Lib.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=2, Str=, Unf=OtherCon []] -Lib.$wfoo = (GHC.Prim.+#) +Lib.$wfoo = GHC.Prim.+# -- RHS size: {terms: 18, types: 14, coercions: 0, joins: 0/0} -foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int +foo [InlPrag=NOUSERINLINE[final]] :: (Int, Int) -> Int -> Int [GblId, Arity=2, Str=, @@ -56,24 +53,25 @@ foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_sHs [Occ=Once!] :: (Int, Int)) - (w1_sHt [Occ=Once!] :: Int) -> - case w_sHs of { (ww1_sHw [Occ=Once!], _ [Occ=Dead]) -> - case ww1_sHw of { GHC.Types.I# ww4_sHz [Occ=Once] -> - case w1_sHt of { GHC.Types.I# ww6_sHF [Occ=Once] -> - case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ [Occ=Once] { __DEFAULT -> - GHC.Types.I# ww7_sHJ + Tmpl= \ (w_sEf [Occ=Once1!] :: (Int, Int)) + (w1_sEg [Occ=Once1!] :: Int) -> + case w_sEf of { (ww1_sEj [Occ=Once1!], _ [Occ=Dead]) -> + case ww1_sEj of { GHC.Types.I# ww4_sEm [Occ=Once1] -> + case w1_sEg of { GHC.Types.I# ww6_sEs [Occ=Once1] -> + case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw [Occ=Once1] + { __DEFAULT -> + GHC.Types.I# ww7_sEw } } } }}] foo - = \ (w_sHs :: (Int, Int)) (w1_sHt :: Int) -> - case w_sHs of { (ww1_sHw, ww2_sHB) -> - case ww1_sHw of { GHC.Types.I# ww4_sHz -> - case w1_sHt of { GHC.Types.I# ww6_sHF -> - case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ { __DEFAULT -> - GHC.Types.I# ww7_sHJ + = \ (w_sEf :: (Int, Int)) (w1_sEg :: Int) -> + case w_sEf of { (ww1_sEj, ww2_sEo) -> + case ww1_sEj of { GHC.Types.I# ww4_sEm -> + case w1_sEg of { GHC.Types.I# ww6_sEs -> + case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw { __DEFAULT -> + GHC.Types.I# ww7_sEw } } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6de40f83c53c3b1899f7b4912badbe98e4fbde88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6de40f83c53c3b1899f7b4912badbe98e4fbde88 You're receiving 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 22 09:38:08 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 22 Sep 2020 05:38:08 -0400 Subject: [Git][ghc/ghc][master] Fix the occurrence analyser Message-ID: <5f69c60083e82_80b1164c4e813650153@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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 @@ -127,6 +123,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,6 +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']) +test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/416bd50e58b23ad70813b18a913ca77a3ab6e936 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/416bd50e58b23ad70813b18a913ca77a3ab6e936 You're receiving 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 22 09:38:44 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 22 Sep 2020 05:38:44 -0400 Subject: =?UTF-8?Q?[Git][ghc/ghc][master]_2_commits:_PmCheck_-_Comments?= =?UTF-8?Q?_only:_Replace_/~_by_=E2=89=81?= Message-ID: <5f69c624cd448_80bd7dfe80136541f3@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 11 changed files: - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/pmcheck/should_compile/T18249.hs - + testsuite/tests/pmcheck/should_compile/T18249.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1347,8 +1347,10 @@ hsExprNeedsParens p = go ExpansionExpr (HsExpanded a _) -> hsExprNeedsParens p a | GhcRn <- ghcPass @p = case x of HsExpanded a _ -> hsExprNeedsParens p a +#if __GLASGOW_HASKELL__ <= 900 | otherwise = True +#endif -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -221,7 +221,7 @@ safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning 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 +match var x, which rules out ⊥ as an inhabitant. So we add x ≁ ⊥ to the initial Nabla and check if there are any values left to match on. -} @@ -781,28 +781,6 @@ 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]@. -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 _ = () - -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] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Similar to Note [Field match order for RecCon], the order in which the guards @@ -872,17 +850,17 @@ instance Outputable a => Outputable (CheckResult a) where field name value = text name <+> equals <+> ppr value -- | Lift 'addPmCts' over 'Nablas'. -addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas -addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -- | 'addPmCtsNablas' for a single 'PmCt'. -addPmCtNablas :: Nablas -> PmCt -> DsM Nablas -addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -- | 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 . +-- terms of @notNull <$> generateInhabitingPatterns 1 ds at . isInhabited :: Nablas -> DsM Bool isInhabited (MkNablas ds) = pure (not (null ds)) @@ -938,26 +916,6 @@ throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | 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 -- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ @@ -969,32 +927,37 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtNablas inc (PmCoreCt x e) - -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + matched <- addPhiCtNablas inc (PhiCoreCt 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 /~ ⊥ + -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ PmBang x mb_info -> do - div <- addPmCtNablas inc (PmBotCt x) - matched <- addPmCtNablas inc (PmNotBotCt x) + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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) + 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: 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 isPmAltConMatchStrict con - then addPmCtNablas inc (PmBotCt x) + then addPhiCtNablas inc (PhiBotCt x) else pure mempty - 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) + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1028,7 +991,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtNablas inc (PmNotBotCt var) + unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1048,7 +1011,7 @@ How do we do that? Consider And imagine we set our limit to 1 for the sake of the example. The first clause 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}. +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 @@ -1056,8 +1019,8 @@ ensure not to make things worse as they are already, so we continue checking 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 -{x~True,y/~True}. +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 @@ -1275,7 +1238,7 @@ getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- provideEvidence vars n nabla + front <- generateInhabitingPatterns vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -1415,7 +1378,8 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1427,7 +1391,7 @@ addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = flip locallyExtendPmNablas k $ \nablas -> - addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) + addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== The diff for this file was not included because it is too large. ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -146,8 +146,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of - Just (alt, _tvs, args) -> pprPmAltCon prec alt args - Nothing -> fromMaybe typed_wildcard <$> checkRefuts x + Just (PACA alt _tvs args) -> pprPmAltCon prec alt args + Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where -- if we have no info about the parameter and would just print a -- wildcard, also show its type. @@ -206,7 +206,7 @@ pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution nabla x + | Just (PACA 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 ===================================== @@ -25,7 +25,7 @@ module GHC.HsToCore.PmCheck.Types ( pmLitAsStringLit, coreExprAsPmLit, -- * Caching residual COMPLETE sets - ConLikeSet, ResidualCompleteMatches(..), getRcm, + ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -33,11 +33,11 @@ module GHC.HsToCore.PmCheck.Types ( -- * A 'DIdEnv' where entries may be shared Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, + setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, -- * The pattern match oracle - BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), - Nablas(..), initNablas, liftNablasM + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -49,6 +49,7 @@ import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Env +import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Name @@ -416,7 +417,7 @@ instance Outputable PmEquality where -- | 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. +-- 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] @@ -437,6 +438,9 @@ data ResidualCompleteMatches getRcm :: ResidualCompleteMatches -> [ConLikeSet] getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + instance Outputable ResidualCompleteMatches where -- formats as "[{Nothing,Just},{P,Q}]" ppr rcm = ppr (getRcm rcm) @@ -485,6 +489,12 @@ setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a setEntrySDIE sdie@(SDIE env) x a = SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) +entriesSDIE :: SharedDIdEnv a -> [a] +entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) + where + preview_entry (Entry e) = Just e + preview_entry _ = Nothing + traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE where @@ -501,13 +511,6 @@ 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. @@ -522,6 +525,9 @@ data TmState -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, @@ -532,11 +538,11 @@ data TmState -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo = VI - { vi_ty :: !Type - -- ^ The type of the variable. Important for rejecting possible GADT - -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@). + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. - , vi_pos :: ![(PmAltCon, [TyVar], [Id])] + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested -- pattern matches involving pattern synonym @@ -552,7 +558,7 @@ data VarInfo -- data T = Leaf Int | Branch T T | Node Int T -- @ -- - -- then @x /~ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- then @x ≁ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, -- and hence can only match @Branch at . Is orthogonal to anything from 'vi_pos', -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing -- between 'vi_pos' and 'vi_neg'. @@ -576,40 +582,76 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + instance Outputable BotInfo where - ppr MaybeBot = empty + ppr MaybeBot = underscore ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps) = ppr state $$ ppr reps + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg bot cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap +initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet --- | 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 InertSet +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } -- | Not user-facing. instance Outputable TyState where - ppr (TySt inert) = ppr inert + ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt emptyInert +initTyState = TySt 0 emptyInert -- | 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 +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 nabla that is always satisfiable initNabla :: Nabla ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot deleted ===================================== @@ -1,9 +0,0 @@ -module GHC.HsToCore.PmCheck.Types where - -import GHC.Data.Bag - -data Nabla - -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1229,7 +1229,9 @@ instance OutputableBndrId id => Outputable (HsExprArg id) where ppr (HsEPar _) = text "HsEPar" ppr (HsEWrap w) = case ghcPass @id of GhcTc -> text "HsEWrap" <+> ppr w +#if __GLASGOW_HASKELL__ <= 900 _ -> empty +#endif type family XExprTypeArg id where XExprTypeArg 'Parsed = NoExtField ===================================== testsuite/tests/pmcheck/should_compile/T18249.hs ===================================== @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedNewtypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +module T18249 where + +import GHC.Exts + +f :: Int# -> Int +-- redundant, not just inaccessible! +f !_ | False = 1 +f _ = 2 + +newtype UVoid :: TYPE 'UnliftedRep where + UVoid :: UVoid -> UVoid + +g :: UVoid -> Int +-- redundant in a weird way: +-- there's no way to actually write this function. +-- Inhabitation testing currently doesn't find that UVoid is empty, +-- but we should be able to detect the bang as redundant. +g !_ = 1 + +h :: (# (), () #) -> Int +-- redundant, not just inaccessible! +h (# _, _ #) | False = 1 +h _ = 2 + +i :: Int -> Int +i !_ | False = 1 +i (I# !_) | False = 2 +i _ = 3 + ===================================== testsuite/tests/pmcheck/should_compile/T18249.stderr ===================================== @@ -0,0 +1,20 @@ + +T18249.hs:14:8: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f !_ | False = ... + +T18249.hs:25:4: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘g’: g _ = ... + +T18249.hs:29:16: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (# _, _ #) | False = ... + +T18249.hs:33:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘i’: i !_ | False = ... + +T18249.hs:34:13: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘i’: i (I# !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -134,6 +134,8 @@ 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('T18249', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns -Wredundant-bang-patterns']) test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/416bd50e58b23ad70813b18a913ca77a3ab6e936...e9501547a8be6af97bcbf38a7ed66dadf02ea27b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/416bd50e58b23ad70813b18a913ca77a3ab6e936...e9501547a8be6af97bcbf38a7ed66dadf02ea27b You're receiving 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 22 11:06:18 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 22 Sep 2020 07:06:18 -0400 Subject: [Git][ghc/ghc][wip/T18126] 2 commits: Improve kind generalisation, error messages Message-ID: <5f69daaa2534d_80b3f84595d58c8136666c6@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: bff82032 by Simon Peyton Jones at 2020-09-22T11:57:36+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 - - - - - 5917ddba by Ben Gamari at 2020-09-22T11:57:36+01:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 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/Expr.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/RAE_T32a.stderr - testsuite/tests/dependent/should_fail/T11407.stderr - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0d5573a342896f52ef859fb5c655165b09b5242...5917ddbaa257e7a47a95e37c73f3e6a730aa01bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0d5573a342896f52ef859fb5c655165b09b5242...5917ddbaa257e7a47a95e37c73f3e6a730aa01bd You're receiving 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 22 14:31:27 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 22 Sep 2020 10:31:27 -0400 Subject: [Git][ghc/ghc][wip/T16762] Working towards doing it better Message-ID: <5f6a0abfd3123_80b3f8410b356041369499f@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: ef6dfbaa by Simon Peyton Jones at 2020-09-22T15:28:51+01:00 Working towards doing it better * Make OuterTyVarBndrs into (essentially) just Either * Define tcOuterSigTKBndrs to - push level, capture constraints etc for Explicit - return the new OuterTyVarBnrs * Define zonkAndSortOuter to do the right thing for the OuterTyVarBndrs returned by tcOuterSigTKBndrs - - - - - 16 changed files: - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.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/Types/Origin.hs - compiler/GHC/ThToHs.hs Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -731,8 +731,6 @@ type family XXLHsQTyVars x -- ------------------------------------- type family XHsOuterImplicit x -type family XHsOuterExplicit x -type family XXHsOuterTyVarBndrs x -- ------------------------------------- ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -398,11 +398,6 @@ deriving instance Data (LHsQTyVars GhcPs) deriving instance Data (LHsQTyVars GhcRn) deriving instance Data (LHsQTyVars GhcTc) --- 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 (DataIsLR p p) => Data (HsSigType p) deriving instance Data (HsSigType GhcPs) deriving instance Data (HsSigType GhcRn) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -30,7 +30,7 @@ module GHC.Hs.Type ( HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind, HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr, LHsQTyVars(..), - HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, + OuterTyVarBndrs(..), HsOuterTyVarBndrs, HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, HsWildCardBndrs(..), HsPatSigType(..), HsPSRn(..), HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType, @@ -412,46 +412,46 @@ emptyLHsQTvs :: LHsQTyVars GhcRn emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] } ------------------------------------------------ --- HsImplicitBndrs (TODO RGS: We need a different title here) +-- OuterTyVarBndrs -- Used to quantify the implicit binders of a type -- * Implicit binders of a type signature (LHsSigType/LHsSigWcType) -- * Patterns in a type/data family instance (HsTyPats) -- -- We support two forms: --- HsOuterImplicit (implicit quantification, added by renamer) +-- OuterImplicit (implicit quantification, added by renamer) -- f :: a -> a -- Short for f :: forall {a}. a->a --- HsOuterExplicit (explicit user quantifiation): +-- OuterExplicit (explicit user quantifiation): -- f :: forall a. a->a -- --- When the user writes /visible/ quanitification +-- In constrast, when the user writes /visible/ quanitification -- T :: forall k -> k -> Type --- we use use HsOuterImplicit, wrapped around a HsForAllTy +-- we use use OuterImplicit, wrapped around a HsForAllTy -- for the visible quantification --- | TODO RGS: Docs -data HsOuterTyVarBndrs flag pass - = HsOuterImplicit - { hso_ximplicit :: XHsOuterImplicit pass - } - | HsOuterExplicit - { hso_xexplicit :: XHsOuterExplicit pass - , hso_bndrs :: [LHsTyVarBndr flag pass] - } - | XHsOuterTyVarBndrs !(XXHsOuterTyVarBndrs pass) - --- | TODO RGS: Docs -type HsOuterFamEqnTyVarBndrs = HsOuterTyVarBndrs () --- | TODO RGS: Docs -type HsOuterSigTyVarBndrs = HsOuterTyVarBndrs Specificity +-- | An explicitly-named Either type +data OuterTyVarBndrs implicit explicit + = OuterImplicit implicit -- Implicit forall + -- f :: a -> b -> b + | OuterExplicit explicit -- Implicit forall + -- f :: forall a b. a -> b-> b + deriving( Data ) + +type HsOuterTyVarBndrs flag pass + = OuterTyVarBndrs + (XHsOuterImplicit pass) -- Implicit bndrs: null in Ps, [Name] in Rn and Tc + [LHsTyVarBndr flag pass] -- Explicit bndrs: LHsTyVarBndr + +-- HsOuterSigTyVarBndrs: used for signatures +-- f :: forall a {b}. blahg +-- HsOuterFamEqnTyVarBndrs: use for type-family inststance eqns +-- type instance forall a. F [a] = Tree a +type HsOuterSigTyVarBndrs pass = HsOuterTyVarBndrs Specificity pass +type HsOuterFamEqnTyVarBndrs pass = HsOuterTyVarBndrs () pass type instance XHsOuterImplicit GhcPs = NoExtField type instance XHsOuterImplicit GhcRn = [Name] type instance XHsOuterImplicit GhcTc = [Name] -type instance XHsOuterExplicit (GhcPass _) = NoExtField - -type instance XXHsOuterTyVarBndrs (GhcPass _) = NoExtCon - -- | Haskell Wildcard Binders data HsWildCardBndrs pass thing -- See Note [HsType binders] @@ -620,24 +620,20 @@ variables so that they can be brought into scope during renaming and typechecking. -} -mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs -mkHsOuterImplicit = HsOuterImplicit { hso_ximplicit = noExtField } +mkHsOuterImplicit :: OuterTyVarBndrs NoExtField explicit +mkHsOuterImplicit = OuterImplicit noExtField -mkHsOuterExplicit :: [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs -mkHsOuterExplicit exp_bndrs = HsOuterExplicit { hso_xexplicit = noExtField - , hso_bndrs = exp_bndrs } +mkHsOuterExplicit :: explicit -> OuterTyVarBndrs implicit explicit +mkHsOuterExplicit = OuterExplicit -mapXHsOuterImplicit :: - (XHsOuterImplicit pass -> XHsOuterImplicit pass) - -> HsOuterTyVarBndrs flag pass -> HsOuterTyVarBndrs flag pass -mapXHsOuterImplicit f (HsOuterImplicit { hso_ximplicit = ximplicit }) = - HsOuterImplicit { hso_ximplicit = f ximplicit } -mapXHsOuterImplicit _ hso at HsOuterExplicit{} = hso -mapXHsOuterImplicit _ hso at XHsOuterTyVarBndrs{} = hso +mapXHsOuterImplicit :: (implicit -> implicit) -> OuterTyVarBndrs implicit explicit + -> OuterTyVarBndrs implicit explicit +mapXHsOuterImplicit f (OuterImplicit imp) = OuterImplicit (f imp) +mapXHsOuterImplicit _ hso@(OuterExplicit {}) = hso mkHsImplicitSigType :: LHsType GhcPs -> HsSigType GhcPs mkHsImplicitSigType body = - HsSig { sig_ext = noExtField + HsSig { sig_ext = noExtField , sig_bndrs = mkHsOuterImplicit, sig_body = body } mkHsExplicitSigType :: [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs @@ -1218,18 +1214,15 @@ 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] + OuterImplicit{} -> nwcs + OuterExplicit tvs -> nwcs ++ hsLTyVarNames tvs + -- See Note [hsScopedTvs vis_flag] hsScopedTvs :: LHsSigType GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of - HsOuterImplicit{} -> - [] - HsOuterExplicit{hso_bndrs = tvs} -> - hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag] + OuterImplicit{} -> [] + OuterExplicit tvs -> hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag] {- Note [Scoping of named wildcards] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1474,9 +1467,9 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4) -> ([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) + OuterImplicit{} -> ([], ignoreParens body) -- TODO RGS: Sigh. Explain why ignoreParens is necessary here. - HsOuterExplicit{hso_bndrs = exp_bndrs} -> (exp_bndrs, body) + OuterExplicit exp_bndrs -> (exp_bndrs, body) (univs, ty1) = split_sig_ty ty (reqs, ty2) = splitLHsQualTy ty1 @@ -1507,8 +1500,8 @@ splitLHsSigmaTyInvis ty -- | Decompose a GADT type into its constituent parts. -- Returns @(outer_bndrs, mb_ctxt, body)@, where: -- --- * @outer_bndrs@ are 'HsOuterExplicit' if the type has explicit, outermost --- type variable binders. Otherwise, they are 'HsOuterImplicit'. +-- * @outer_bndrs@ are 'OuterExplicit' if the type has explicit, outermost +-- type variable binders. Otherwise, they are 'OuterImplicit'. -- -- * @mb_ctxt@ is @Just@ the context, if it is provided. -- Otherwise, it is @Nothing at . @@ -1608,10 +1601,8 @@ 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) + OuterImplicit imp_tkvs -> (imp_tkvs, ctxt, body_ty) + OuterExplicit exp_bndrs -> (hsLTyVarNames exp_bndrs, ctxt, body_ty) where (mb_cxt, body_ty) = splitLHsQualTy_KP inst_ty ctxt = fromMaybe noLHsContext mb_cxt @@ -1843,15 +1834,10 @@ instance OutputableBndrId p => Outputable (LHsQTyVars (GhcPass p)) where ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs -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 - GhcRn -> colon <+> ppr implicit_vars - GhcTc -> colon <+> ppr implicit_vars - ppr (HsOuterExplicit { hso_bndrs = bndrs }) = - text "HsOuterExplicit:" <+> ppr bndrs +instance (Outputable implicit, Outputable explicit) + => Outputable (OuterTyVarBndrs implicit explicit) where + ppr (OuterImplicit implicit) = text "OuterImplicit:" <+> ppr implicit + ppr (OuterExplicit explicit) = text "OuterExplicit:" <+> ppr explicit instance OutputableBndrId p => Outputable (HsForAllTelescope (GhcPass p)) where @@ -1880,16 +1866,15 @@ pprAnonWildCard = char '_' -- TODO RGS: Update the Haddocks, as they're now out of date. pprHsOuterFamEqnTyVarBndrs :: OutputableBndrId p => HsOuterFamEqnTyVarBndrs (GhcPass p) -> SDoc -pprHsOuterFamEqnTyVarBndrs (HsOuterImplicit{}) = empty -pprHsOuterFamEqnTyVarBndrs (HsOuterExplicit{hso_bndrs = qtvs}) = - forAllLit <+> interppSP qtvs <> dot +pprHsOuterFamEqnTyVarBndrs (OuterImplicit{}) = empty +pprHsOuterFamEqnTyVarBndrs (OuterExplicit qtvs) = forAllLit <+> interppSP qtvs <> dot -- | TODO RGS: Docs pprHsOuterSigTyVarBndrs :: OutputableBndrId p => HsOuterSigTyVarBndrs (GhcPass p) -> SDoc -pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty -pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = - pprHsForAll (mkHsForAllInvisTele bndrs) noLHsContext +pprHsOuterSigTyVarBndrs (OuterImplicit{}) = empty +pprHsOuterSigTyVarBndrs (OuterExplicit 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. ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -362,8 +362,8 @@ get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name] -- -- 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 + OuterImplicit imp_tv_names -> imp_tv_names + OuterExplicit exp_tvs -> hsLTyVarNames exp_tvs {- Notes @@ -1012,9 +1012,9 @@ rep_ty_sig_tvs explicit_tvs -- and Note [Don't quantify implicit type variables in quotes] rep_ty_sig_outer_tvs :: HsOuterSigTyVarBndrs GhcRn -> MetaM (Core [M TH.TyVarBndrSpec]) -rep_ty_sig_outer_tvs (HsOuterImplicit{}) = +rep_ty_sig_outer_tvs (OuterImplicit{}) = coreListM tyVarBndrSpecTyConName [] -rep_ty_sig_outer_tvs (HsOuterExplicit{hso_bndrs = explicit_tvs}) = +rep_ty_sig_outer_tvs (OuterExplicit explicit_tvs) = rep_ty_sig_tvs explicit_tvs -- Desugar a top-level type signature. Unlike 'repHsSigType', this @@ -1168,12 +1168,10 @@ addHsOuterFamEqnTyVarBinds :: addHsOuterFamEqnTyVarBinds outer_bndrs thing_inside = do elt_ty <- wrapName tyVarBndrUnitTyConName case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_tvs} -> - addTyClTyVarBinds (mk_qtvs imp_tvs []) $ \_th_exp_bndrs -> - thing_inside $ coreNothingList elt_ty - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - addTyClTyVarBinds (mk_qtvs [] exp_bndrs) $ \th_exp_bndrs -> - thing_inside $ coreJustList elt_ty th_exp_bndrs + OuterImplicit imp_tvs -> addTyClTyVarBinds (mk_qtvs imp_tvs []) $ \_th_exp_bndrs -> + thing_inside $ coreNothingList elt_ty + OuterExplicit exp_bndrs -> addTyClTyVarBinds (mk_qtvs [] exp_bndrs) $ \th_exp_bndrs -> + thing_inside $ coreJustList elt_ty th_exp_bndrs where mk_qtvs imp_tvs exp_tvs = HsQTvs { hsq_ext = imp_tvs , hsq_explicit = exp_tvs } @@ -1183,22 +1181,20 @@ addHsOuterSigTyVarBinds :: -> (Core [M TH.TyVarBndrSpec] -> MetaM (Core (M a))) -> MetaM (Core (M a)) 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 + OuterImplicit imp_tvs -> do th_nil <- coreListM tyVarBndrSpecTyConName [] + addSimpleTyVarBinds imp_tvs $ thing_inside th_nil + OuterExplicit exp_bndrs -> addHsTyVarBinds exp_bndrs thing_inside -- TODO RGS: Docs nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool -nullOuterImplicit (HsOuterImplicit{hso_ximplicit = imp_bndrs}) = null imp_bndrs -nullOuterImplicit (HsOuterExplicit{}) = True +nullOuterImplicit (OuterImplicit imp_bndrs) = null imp_bndrs +nullOuterImplicit (OuterExplicit{}) = 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 +nullOuterExplicit (OuterExplicit exp_bndrs) = null exp_bndrs +nullOuterExplicit (OuterImplicit {}) = True -- Vacuously true, as there is no outermost explicit quantification addSimpleTyVarBinds :: [Name] -- the binders to be added ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -546,10 +546,8 @@ instance HasLoc a => HasLoc [a] where instance HasLoc a => HasLoc (FamEqn (GhcPass s) a) where loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of - HsOuterImplicit{} -> foldl1' combineSrcSpans - [loc a, loc b, loc c] - HsOuterExplicit{hso_bndrs = tvs} -> foldl1' combineSrcSpans - [loc a, loc tvs, loc b, loc c] + OuterImplicit{} -> foldl1' combineSrcSpans [loc a, loc b, loc c] + OuterExplicit tvs -> foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where loc (HsValArg tm) = loc tm loc (HsTypeArg _ ty) = loc ty @@ -1551,11 +1549,10 @@ instance ToHie (Located (ConDecl GhcRn)) where , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } -> [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names , case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_vars} -> - bindingsOnly $ map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope) - imp_vars - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - toHie $ tvScopes resScope NoScope exp_bndrs + OuterImplicit imp_vars -> bindingsOnly $ + map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope) + imp_vars + OuterExplicit exp_bndrs -> toHie $ tvScopes resScope NoScope exp_bndrs , toHie ctx , toHie args , toHie typ ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -941,8 +941,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 = bndrs} -> registerLocHdkA (getLHsTyVarBndrsLoc bndrs) + OuterImplicit{} -> pure () + OuterExplicit bndrs -> registerLocHdkA (getLHsTyVarBndrsLoc bndrs) body' <- addHaddock body pure $ L l $ HsSig noExtField outer_bndrs body' ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1056,17 +1056,16 @@ bindHsOuterTyVarBndrs :: OutputableBndrFlag flag -> RnM (a, FreeVars) bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{} -> + OuterImplicit{} -> rnImplicitBndrs mb_cls implicit_vars $ \implicit_vars' -> - thing_inside $ HsOuterImplicit{ hso_ximplicit = implicit_vars' } - HsOuterExplicit{hso_bndrs = exp_bndrs} -> + thing_inside $ OuterImplicit implicit_vars' + OuterExplicit exp_bndrs -> -- Note: If we pass mb_cls instead of Nothing below, bindLHsTyVarBndrs -- will use class variables for any names the user meant to bring in -- scope here. This is an explicit forall, so we want fresh names, not -- class variables. Thus: always pass Nothing. bindLHsTyVarBndrs doc WarnUnusedForalls Nothing exp_bndrs $ \exp_bndrs' -> - thing_inside $ HsOuterExplicit{ hso_xexplicit = noExtField - , hso_bndrs = exp_bndrs' } + thing_inside $ OuterExplicit exp_bndrs' bindHsForAllTelescope :: HsDocContext -> HsForAllTelescope GhcPs @@ -1888,10 +1887,8 @@ extractHsOuterTvBndrs :: HsOuterTyVarBndrs flag GhcPs -> FreeKiTyVars -- Free in result extractHsOuterTvBndrs outer_bndrs body_fvs = case outer_bndrs of - HsOuterImplicit{} -> - body_fvs - HsOuterExplicit { hso_bndrs = bndrs } -> - extract_hs_tv_bndrs bndrs [] body_fvs + OuterImplicit{} -> body_fvs + OuterExplicit bndrs -> extract_hs_tv_bndrs bndrs [] body_fvs extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars -- Accumulator ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -753,8 +753,8 @@ rnFamEqn doc atfi rhs_kvars ; let nms_used = extendNameSetList rhs_fvs $ inst_tvs ++ nms_dups all_nms = case rn_outer_bndrs' of - HsOuterImplicit{hso_ximplicit = imp_var_nms} -> imp_var_nms - HsOuterExplicit{hso_bndrs = bndrs} -> hsLTyVarNames bndrs + OuterImplicit imp_var_nms -> imp_var_nms + OuterExplicit bndrs -> hsLTyVarNames bndrs ; warnUnusedTypePatterns all_nms nms_used ; let eqn_fvs = rhs_fvs `plusFV` pat_fvs @@ -1956,8 +1956,8 @@ rnLDerivStrategy doc mds thing_inside -- 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 + OuterImplicit imp_tvs -> imp_tvs + OuterExplicit 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] ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -202,8 +202,8 @@ checkInferredVars ctxt (Just msg) ty = where sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs] sig_ty_bndrs (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of - HsOuterImplicit{} -> [] - HsOuterExplicit{hso_bndrs = exp_bndrs} -> map unLoc exp_bndrs + OuterImplicit{} -> [] + OuterExplicit exp_bndrs -> map unLoc exp_bndrs {- Note [Unobservably inferred type variables] ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -502,7 +502,7 @@ warnRedundantConstraints ctxt env info ev_vars = any isImprovementPred (pred : transSuperClasses pred) reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM () -reportBadTelescope ctxt env (ForAllSkol _ telescope) skols +reportBadTelescope ctxt env (ForAllSkol telescope) skols = do { msg <- mkErrorReport ctxt env (important doc) ; reportError msg } where ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -29,9 +29,11 @@ module GHC.Tc.Gen.HsType ( bindImplicitTKBndrs_Q_Tv, bindImplicitTKBndrs_Q_Skol, bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol, + + tcOuterSigTKBndrs, zonkAndSortOuter, + bindOuterFamEqnTKBndrs_Q_Skol, bindOuterFamEqnTKBndrs_Q_Tv, bindOuterSigTKBndrs_Tv, bindOuterSigTKBndrs_Skol, - ContextKind(..), -- Type checking type and class decls, and instances thereof bindTyClTyVars, tcFamTyPats, @@ -44,6 +46,7 @@ module GHC.Tc.Gen.HsType ( -- No kind generalisation, no checkValidType InitialKindStrategy(..), SAKS_or_CUSK(..), + ContextKind(..), kcDeclHeader, tcNamedWildCardBinders, tcHsLiftedType, tcHsOpenType, @@ -387,31 +390,19 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- f :: a -> t a -> t a -- then bring those implicit binders into scope here. - let body_hs_ty :: LHsType GhcRn - implicit_bndrs :: [Name] - (implicit_bndrs, body_hs_ty) - = case outer_bndrs of - HsOuterExplicit { hso_bndrs = bndrs } - -> ([], L loc $ - HsForAllTy { hst_xforall = noExtField - , hst_tele = HsForAllInvis { hsf_xinvis = noExtField - , hsf_invis_bndrs = bndrs } - , hst_body = hs_ty }) - HsOuterImplicit { hso_ximplicit = implicit_bndrs } - -> (implicit_bndrs, hs_ty) - - ; (tc_lvl, (wanted, (implicit_tkvs, ty))) + ; (tc_lvl, (wanted, (outer_bndrs, ty))) <- pushTcLevelM $ solveLocalEqualitiesX "tc_hs_sig_type" $ -- See Note [Failure in local type signatures] - bindImplicitTKBndrs_Skol implicit_bndrs $ + tcOuterSigTKBndrs outer_bndrs $ do { kind <- newExpectedKind ctxt_kind - ; tcLHsType body_hs_ty kind } + ; tcLHsType hs_ty kind } -- Any remaining variables (unsolved in the solveLocalEqualities) -- should be in the global tyvars, and therefore won't be quantified - ; implicit_tkvs <- zonkAndScopedSort implicit_tkvs - ; let ty1 = mkSpecForAllTys implicit_tkvs ty + ; (outer_tv_bndrs :: [InvisTVBinder]) <- zonkAndSortOuter outer_bndrs + + ; let ty1 = mkInvisForAllTys outer_tv_bndrs ty -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, -- but constraints are so much simpler in kinds, it is much @@ -424,7 +415,8 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- Build an implication for any as-yet-unsolved kind equalities -- See Note [Skolem escape in type signatures] - ; implic <- buildTvImplication skol_info (kvs ++ implicit_tkvs) tc_lvl wanted + ; let skol_tvs = kvs ++ binderVars outer_tv_bndrs + ; implic <- buildTvImplication skol_info skol_tvs tc_lvl wanted ; return (implic, mkInfForAllTys kvs ty1) } @@ -1020,10 +1012,9 @@ tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind = tc_fun_type mode HsUnrestrictedArrow ty1 ty2 exp_kind --------- Foralls -tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind - = do { (tclvl, wanted, (tv_bndrs, ty')) - <- pushLevelAndCaptureConstraints $ - bindExplicitTKTele_Skol_M mode tele $ +tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind + = do { (tv_bndrs, ty') + <- tcTKTelescope mode tele $ -- The _M variant passes on the mode from the type, to -- any wildcards in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah @@ -1032,18 +1023,6 @@ tc_hs_type mode forall@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind -- Do not kind-generalise here! See Note [Kind generalisation] - ; let skol_info = ForAllSkol (ppr forall) $ sep $ case tele of - HsForAllVis { hsf_vis_bndrs = hs_tvs } -> - map ppr hs_tvs - HsForAllInvis { hsf_invis_bndrs = hs_tvs } -> - map ppr hs_tvs - skol_tvs = binderVars tv_bndrs - ; implic <- buildTvImplication skol_info skol_tvs tclvl wanted - ; emitImplication implic - -- /Always/ emit this implication even if wanted is empty - -- We need the implication so that we check for a bad telescope - -- See Note [Skolem escape and forall-types] - ; return (mkForAllTys tv_bndrs ty') } tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind @@ -2982,25 +2961,71 @@ cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar -- Explicit binders -------------------------------------- --- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied --- 'TcTyMode'. -bindExplicitTKTele_Skol_M - :: TcTyMode - -> HsForAllTelescope GhcRn - -> TcM a - -> TcM ([TcTyVarBinder], a) -bindExplicitTKTele_Skol_M mode tele thing_inside = case tele of +tcTKTelescope :: TcTyMode + -> HsForAllTelescope GhcRn + -> TcM a + -> TcM ([TcTyVarBinder], a) +tcTKTelescope mode tele thing_inside = case tele of HsForAllVis { hsf_vis_bndrs = bndrs } - -> do { (req_tv_bndrs, thing) <- bindExplicitTKBndrs_Skol_M mode bndrs thing_inside + -> do { (req_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside -- req_tv_bndrs :: [VarBndr TyVar ()], -- but we want [VarBndr TyVar ArgFlag] ; return (tyVarReqToBinders req_tv_bndrs, thing) } HsForAllInvis { hsf_invis_bndrs = bndrs } - -> do { (inv_tv_bndrs, thing) <- bindExplicitTKBndrs_Skol_M mode bndrs thing_inside + -> do { (inv_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside -- inv_tv_bndrs :: [VarBndr TyVar Specificity], -- but we want [VarBndr TyVar ArgFlag] ; return (tyVarSpecToBinders inv_tv_bndrs, thing) } +zonkAndSortOuter :: OuterTyVarBndrs [TcTyVar] [TcInvisTVBinder] + -> TcM [TcInvisTVBinder] +zonkAndSortOuter (OuterImplicit imp_tvs) + = do { imp_tvs <- zonkAndScopedSort imp_tvs + ; return [Bndr tv SpecifiedSpec | tv <- imp_tvs] } +zonkAndSortOuter (OuterExplicit exp_tvs) + = -- No need to dependency-sort explicit quantifiers + return exp_tvs + +tcOuterSigTKBndrs + :: HsOuterSigTyVarBndrs GhcRn + -> TcM a + -> TcM ( OuterTyVarBndrs [TcTyVar] -- Implicit + [TcInvisTVBinder] -- Explicit, with Specificity + , a) +tcOuterSigTKBndrs (OuterImplicit implicit_nms) thing_inside + = -- Implicit: just bind the variables; no push levels, no capturing constraints + do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_nms thing_inside + ; return (OuterImplicit imp_tvs, thing) } +tcOuterSigTKBndrs (OuterExplicit hs_bndrs) thing_inside + = -- Explicit: push level, capture constraints, make implication + do { (bndrs, thing) <- tcExplicitTKBndrs (mkMode TypeLevel) hs_bndrs thing_inside + ; return (OuterExplicit bndrs, thing) } + +tcExplicitTKBndrs :: OutputableBndrFlag flag + => TcTyMode + -> [LHsTyVarBndr flag GhcRn] + -> TcM a + -> TcM ([VarBndr TyVar flag], a) +-- Push level, capture constraints, solve them, and emit an +-- implication constraint with a ForAllSkol ic_info, so that it +-- is subject to a telescope test. +tcExplicitTKBndrs mode bndrs thing_inside + = do { (tclvl, wanted, (skol_tvs, res)) + <- pushLevelAndCaptureConstraints $ + bindExplicitTKBndrs_Skol_M mode bndrs $ + thing_inside + + ; let skol_info = ForAllSkol (ppr bndrs) + ; implic <- buildTvImplication skol_info (binderVars skol_tvs) tclvl wanted + ; emitImplication implic + -- /Always/ emit this implication even if wanted is empty + -- We need the implication so that we check for a bad telescope + -- See Note [Skolem escape and forall-types] + + ; return (skol_tvs, res) } + +-- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied +-- 'TcTyMode'. bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv :: (OutputableBndrFlag flag) => [LHsTyVarBndr flag GhcRn] @@ -3068,6 +3093,7 @@ bindExplicitTKBndrsX tc_tv hs_tvs thing_inside -- Outer type variable binders -------------------------------------- + -- TODO RGS: Which of these do we actually need? -- TODO RGS: Docs(?) @@ -3078,9 +3104,9 @@ bindOuterFamEqnTKBndrs_Q_Skol :: ContextKind -> TcM a -> TcM ([TcTyVar], a) bindOuterFamEqnTKBndrs_Q_Skol ctxt_kind outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do + OuterImplicit implicit_tkv_nms -> do bindImplicitTKBndrs_Q_Skol implicit_tkv_nms thing_inside - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do + OuterExplicit exp_bndrs -> do bindExplicitTKBndrs_Q_Skol ctxt_kind exp_bndrs thing_inside -- TODO RGS: Docs(?) @@ -3091,9 +3117,9 @@ 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} + OuterImplicit implicit_tkv_nms -> bindImplicitTKBndrs_Q_Tv implicit_tkv_nms thing_inside - HsOuterExplicit{hso_bndrs = exp_bndrs} + OuterExplicit exp_bndrs -> bindExplicitTKBndrs_Q_Tv ctxt_kind exp_bndrs thing_inside -- TODO RGS: Docs(?) @@ -3103,10 +3129,10 @@ bindOuterSigTKBndrs_Skol :: HsOuterSigTyVarBndrs GhcRn -> TcM a -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) bindOuterSigTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + OuterImplicit implicit_tkv_nms -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside ; pure (Left imp_tvs, thing) } - HsOuterExplicit{hso_bndrs = exp_bndrs} + OuterExplicit exp_bndrs -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol exp_bndrs thing_inside ; pure (Right exp_bndrs', thing) } @@ -3117,10 +3143,10 @@ 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} + OuterImplicit implicit_tv_names -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tv_names thing_inside ; pure (Left imp_tvs, thing) } - HsOuterExplicit{hso_bndrs = exp_bndrs} + OuterExplicit exp_bndrs -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv exp_bndrs thing_inside ; pure (Right exp_bndrs', thing) } @@ -3132,10 +3158,10 @@ bindOuterSigTKBndrs_Skol_M :: TcTyMode -> TcM a -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) bindOuterSigTKBndrs_Skol_M mode outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + OuterImplicit implicit_tkv_nms -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside ; pure (Left imp_tvs, thing) } - HsOuterExplicit{hso_bndrs = exp_bndrs} + OuterExplicit exp_bndrs -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol_M mode exp_bndrs thing_inside ; pure (Right exp_bndrs', thing) } @@ -3147,10 +3173,10 @@ bindOuterSigTKBndrs_Tv_M :: TcTyMode -> TcM a -> TcM ([TcInvisTVBinder], a) bindOuterSigTKBndrs_Tv_M mode outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + OuterImplicit 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} + OuterExplicit exp_bndrs -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv_M mode exp_bndrs thing_inside ; pure (exp_bndrs', thing) } @@ -3659,8 +3685,8 @@ tcHsPartialSigType ctxt sig_ty -- 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 + OuterImplicit imp_tvs -> imp_tvs + OuterExplicit 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 ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -270,8 +270,8 @@ isCompleteHsSig (HsWC { hswc_ext = wcs, hswc_body = 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 + OuterImplicit{} -> no_anon_wc_ty body + OuterExplicit 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 ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2451,7 +2451,7 @@ getGhciStepIO = do step_ty :: LHsSigType GhcRn step_ty = noLoc $ HsSig - { sig_bndrs = HsOuterImplicit{hso_ximplicit = [a_tv]} + { sig_bndrs = OuterImplicit [a_tv] , sig_ext = noExtField , sig_body = nlHsFunTy HsUnrestrictedArrow ghciM ioM } ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -3252,11 +3252,11 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data do { traceTc "tcConDecl 1 gadt" (ppr names) ; let (L _ name : _) = names - ; (imp_or_exp_tvs, (ctxt, arg_tys, res_ty, field_lbls, stricts)) + ; (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts)) <- pushTcLevelM_ $ -- We are going to generalise solveEqualities $ -- We won't get another crack, and we don't -- want an error cascade - bindOuterSigTKBndrs_Skol outer_bndrs $ + tcOuterSigTKBndrs outer_bndrs $ do { ctxt <- tcHsMbContext cxt ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] @@ -3269,16 +3269,14 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; field_lbls <- lookupConstructorFields name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) } - ; imp_or_exp_tvs <- bitraverse zonkAndScopedSort pure imp_or_exp_tvs + ; (outer_tv_bndrs :: [TcInvisTVBinder]) <- zonkAndSortOuter outer_bndrs - ; tkvs <- kindGeneralizeAll (either mkSpecForAllTys mkInvisForAllTys - imp_or_exp_tvs $ + ; tkvs <- kindGeneralizeAll (mkInvisForAllTys outer_tv_bndrs $ mkPhiTy ctxt $ mkVisFunTys arg_tys $ res_ty) - ; let tvbndrs = (mkTyVarBinders InferredSpec tkvs) - ++ either (mkTyVarBinders SpecifiedSpec) id imp_or_exp_tvs + ; let tvbndrs = mkTyVarBinders InferredSpec tkvs ++ outer_tv_bndrs -- Zonk to Types ; (ze, tvbndrs) <- zonkTyVarBinders tvbndrs ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -189,7 +189,6 @@ data SkolemInfo -- hence, we have less info | ForAllSkol -- Bound by a user-written "forall". - SDoc -- Shows the entire forall type SDoc -- Shows just the binders, used when reporting a bad telescope -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint @@ -249,7 +248,7 @@ pprSkolInfo :: SkolemInfo -> SDoc -- Complete the sentence "is a rigid type variable bound by..." pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx -pprSkolInfo (ForAllSkol pt _) = quotes pt +pprSkolInfo (ForAllSkol tvs) = text "an explicit forall" <+> tvs pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for" <+> pprWithCommas ppr ips pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred) ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -613,8 +613,8 @@ cvtConstr (ForallC tvs ctxt con) all_tvs = tvs' ++ outer_exp_tvs outer_exp_tvs = case outer_bndrs of - HsOuterImplicit{} -> [] - HsOuterExplicit{hso_bndrs = bndrs} -> bndrs + OuterImplicit{} -> [] + OuterExplicit bndrs -> bndrs add_forall tvs' cxt' con@(ConDeclH98 { con_ex_tvs = ex_tvs, con_mb_cxt = cxt }) = con { con_forall = noLoc $ not (null all_tvs) @@ -1412,7 +1412,7 @@ cvtDerivClauseTys tys -- unless the TH.Cxt is a singleton list whose type is a bare type -- constructor with no arguments. ; case tys' of - [ty'@(L l (HsSig { sig_bndrs = HsOuterImplicit{} + [ty'@(L l (HsSig { sig_bndrs = OuterImplicit{} , sig_body = L _ (HsTyVar _ NotPromoted _) }))] -> return $ L l $ DctSingle noExtField ty' _ -> returnL $ DctMulti noExtField tys' } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6dfbaacffbaddc0a20a28fb00141f327f63761 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6dfbaacffbaddc0a20a28fb00141f327f63761 You're receiving 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 22 15:37:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 22 Sep 2020 11:37:31 -0400 Subject: [Git][ghc/ghc][wip/T14620] 456 commits: Bump Cabal submodule Message-ID: <5f6a1a3bc5421_80b3f84611c6a6813712754@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14620 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 107ddb90 by Sebastian Graf at 2020-09-22T17:37:21+02:00 WIP: Fix #14620 by introducing WW to detect more join points - - - - - 24 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - CODEOWNERS - Makefile - README.md - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d42a2b42a9be618f52b8bdb3c00f986d032f521a...107ddb902233f607a3613bcfa48d2ff7f6299e8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d42a2b42a9be618f52b8bdb3c00f986d032f521a...107ddb902233f607a3613bcfa48d2ff7f6299e8d You're receiving 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 22 15:52:34 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 22 Sep 2020 11:52:34 -0400 Subject: [Git][ghc/ghc][wip/T14620] WIP: Fix #14620 by introducing WW to detect more join points Message-ID: <5f6a1dc2f114a_80b3f8468d2d9b81371497c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14620 at Glasgow Haskell Compiler / GHC Commits: ee89bb7b by Sebastian Graf at 2020-09-22T17:52:26+02:00 WIP: Fix #14620 by introducing WW to detect more join points - - - - - 7 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Ppr.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2984,9 +2984,6 @@ decideJoinPointHood NotTopLevel usage bndrs -- Invariant 2a: stable unfoldings -- See Note [Join points and INLINE pragmas] , ok_unfolding arity (realIdUnfolding bndr) - - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) = True | otherwise ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType , pushCoTyArg, pushCoValArg , idArityType, etaExpandAT ) -import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe ) +import GHC.Core.SimpleOpt ( tryJoinPointWW, tryJoinPointWWs ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) import GHC.Types.Basic @@ -1052,8 +1052,9 @@ simplExprF1 env (Case scrut bndr _ alts) cont , sc_env = env, sc_cont = cont }) simplExprF1 env (Let (Rec pairs) body) cont - | Just pairs' <- joinPointBindings_maybe pairs - = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' body cont + | Just (pairs', wrappers) <- tryJoinPointWWs (getInScope env) (exprType body) pairs + -- , null wrappers || pprTrace "simple join Rec" (ppr pairs'<+> ppr (exprType body)) True + = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' wrappers body cont | otherwise = {-#SCC "simplRecE" #-} simplRecE env pairs body cont @@ -1065,8 +1066,9 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont do { ty' <- simplType env ty ; simplExprF (extendTvSubst env bndr ty') body cont } - | Just (bndr', rhs') <- joinPointBinding_maybe bndr rhs - = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' body cont + | Just (bndr', rhs', wrappers) <- tryJoinPointWW (getInScope env) (exprType body) bndr rhs + -- , null wrappers || pprTrace "simple join NonRec" (ppr bndr' $$ ppr (idType bndr') $$ ppr (exprType body) $$ ppr (isJoinId bndr) $$ ppr wrappers) True + = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' wrappers body cont | otherwise = {-#SCC "simplNonRecE" #-} simplNonRecE env bndr (rhs, env) ([], body) cont @@ -1684,33 +1686,41 @@ type MaybeJoinCont = Maybe SimplCont -- Just k => This is a join binding with continuation k -- See Note [Rules and unfolding for join points] -simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplNonRecJoinPoint env bndr rhs body cont +preInlineJoinWrappers :: SimplEnv -> [(InId, InExpr)] -> SimplEnv +preInlineJoinWrappers env binds + = foldl' (\env (b,r) -> extendIdSubst env b (mkContEx env r)) env' binds + where + env' = addNewInScopeIds env (map fst binds) + +simplNonRecJoinPoint + :: SimplEnv -> InId -> InExpr -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecJoinPoint env bndr rhs wrappers body cont | ASSERT( isJoinId bndr ) True - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env + , ASSERT( wrappers `lengthAtMost` 1 ) True + , Just env1 <- preInlineUnconditionally env NotTopLevel bndr rhs env = do { tick (PreInlineUnconditionally bndr) - ; simplExprF env' body cont } - - | otherwise - = wrapJoinCont env cont $ \ env cont -> - do { -- We push join_cont into the join RHS and the body; - -- and wrap wrap_cont around the whole thing - ; let mult = contHoleScaling cont - res_ty = contResultType cont - ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty - ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) - ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env - ; (floats2, body') <- simplExprF env3 body cont - ; return (floats1 `addFloats` floats2, body') } + ; let env2 = preInlineJoinWrappers env1 wrappers + ; simplExprF env2 body cont } + | otherwise + = wrapJoinCont env cont $ \ env cont -> + do { -- We push join_cont into the join RHS and the body; + -- and wrap wrap_cont around the whole thing + ; let mult = contHoleScaling cont + res_ty = contResultType cont + ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) + ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env + ; let env4 = preInlineJoinWrappers env3 wrappers + ; (floats2, body') <- simplExprF env4 body cont + ; return (floats1 `addFloats` floats2, body') } ------------------ -simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)] - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplRecJoinPoint env pairs body cont +simplRecJoinPoint + :: SimplEnv -> [(InId, InExpr)] -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplRecJoinPoint env pairs wrappers body cont = wrapJoinCont env cont $ \ env cont -> do { let bndrs = map fst pairs mult = contHoleScaling cont @@ -1718,8 +1728,9 @@ simplRecJoinPoint env pairs body cont ; env1 <- simplRecJoinBndrs env bndrs mult res_ty -- NB: bndrs' don't have unfoldings or rules -- We add them as we go down - ; (floats1, env2) <- simplRecBind env1 NotTopLevel (Just cont) pairs - ; (floats2, body') <- simplExprF env2 body cont + ; let env2 = preInlineJoinWrappers env1 wrappers + ; (floats1, env3) <- simplRecBind env2 NotTopLevel (Just cont) pairs + ; (floats2, body') <- simplExprF env3 body cont ; return (floats1 `addFloats` floats2, body') } -------------------- ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Core.SimpleOpt ( SimpleOpts (..), defaultSimpleOpts, @@ -13,7 +14,7 @@ module GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr, simpleOptExprWith, -- ** Join points - joinPointBinding_maybe, joinPointBindings_maybe, + tryJoinPointWW, tryJoinPointWWs, -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, @@ -36,7 +37,7 @@ import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) ) -import GHC.Types.Var ( isNonCoVarId ) +import GHC.Types.Var ( isNonCoVarId, setVarType, VarBndr (..) ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core.DataCon @@ -44,7 +45,11 @@ import GHC.Types.Demand( etaConvertStrictSig ) import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) +import qualified GHC.Core.Type as Type import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) +import GHC.Core.TyCo.Rep ( TyCoBinder (..) ) +import GHC.Core.Multiplicity +import GHC.Core.Unify ( tcMatchTy ) import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Types.Basic @@ -52,8 +57,10 @@ import GHC.Unit.Module ( Module ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Data.Maybe ( orElse ) +import GHC.Utils.Monad ( mapAccumLM ) +import GHC.Data.Maybe import GHC.Data.FastString +import Data.Bifunctor ( first ) import Data.List import qualified Data.ByteString as BS @@ -172,14 +179,14 @@ simpleOptPgm opts this_mod binds rules = -- hence paying just a substitution do_one (env, binds') bind - = case simple_opt_bind env bind TopLevel of + = case simple_opt_bind env bind of (env', Nothing) -> (env', binds') (env', Just bind') -> (env', bind':binds') -- In these functions the substitution maps InVar -> OutExpr ---------------------- -type SimpleClo = (SimpleOptEnv, InExpr) +type SimpleClo = (SimpleOptEnv, InExpr) -- Like SimplSR's ContEx data SimpleOptEnv = SOE { soe_co_opt_opts :: !OptCoercionOpts @@ -191,7 +198,8 @@ data SimpleOptEnv , soe_inl :: IdEnv SimpleClo -- ^ Deals with preInlineUnconditionally; things -- that occur exactly once and are inlined - -- without having first been simplified + -- without having first been simplified or + -- substituted, thus the domain is InBndrs , soe_subst :: Subst -- ^ Deals with cloning; includes the InScopeSet @@ -247,9 +255,10 @@ simple_opt_expr env expr go (Lit lit) = Lit lit go (Tick tickish e) = mkTick (substTickish subst tickish) (go e) go (Cast e co) = mk_cast (go e) (go_co co) - go (Let bind body) = case simple_opt_bind env bind NotTopLevel of - (env', Nothing) -> simple_opt_expr env' body - (env', Just bind) -> Let bind (simple_opt_expr env' body) + go (Let bind body) = + case simple_opt_local_bind env (exprType body) bind of + (env', Nothing) -> simple_opt_expr env' body + (env', Just bind) -> Let bind (simple_opt_expr env' body) go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) @@ -351,7 +360,7 @@ simple_app env (Tick t e) as -- However, do /not/ do this transformation for join points -- See Note [simple_app and join points] simple_app env (Let bind body) args - = case simple_opt_bind env bind NotTopLevel of + = case simple_opt_local_bind env (exprType body) bind of (env', Nothing) -> simple_app env' body args (env', Just bind') | isJoinBind bind' -> finish_app env expr' args @@ -369,29 +378,87 @@ finish_app env fun (arg:args) = finish_app env (App fun (simple_opt_clo env arg)) args ---------------------- -simple_opt_bind :: SimpleOptEnv -> InBind -> TopLevelFlag - -> (SimpleOptEnv, Maybe OutBind) -simple_opt_bind env (NonRec b r) top_level - = (env', case mb_pr of - Nothing -> Nothing - Just (b,r) -> Just (NonRec b r)) +extendInlEnv :: SimpleOptEnv -> InBndr -> SimpleClo -> SimpleOptEnv +-- Like GHC.Core.Opt.Simplify.Env.extendIdSubst +extendInlEnv env@(SOE { soe_inl = inl_env }) bndr clo + = ASSERT2( isId bndr && not (isCoVar bndr), ppr bndr ) + env { soe_inl = extendVarEnv inl_env bndr clo } + +extendInScopeEnv :: SimpleOptEnv -> [InBndr] -> SimpleOptEnv +extendInScopeEnv env@(SOE { soe_subst = Subst in_scope ids tvs cos }) bndrs + = env { soe_subst = Subst (extendInScopeSetList in_scope bndrs) ids tvs cos } + +tryJoinPointWWs :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe ([(InBndr, InExpr)], [(InBndr, InExpr)]) +tryJoinPointWWs in_scope body_ty binds + = foldMap go <$> joinPointBindings_maybe in_scope body_ty binds where - (b', r') = joinPointBinding_maybe b r `orElse` (b, r) - (env', mb_pr) = simple_bind_pair env b' Nothing (env,r') top_level + go jph = ([(join_bndr jph, join_rhs jph)], join_wrapper jph) + join_wrapper jph at JoinPointAfterMono{} -- Rare: A join point after we inline a wrapper + = [(join_wrapper_bndr jph, join_wrapper_body jph)] + join_wrapper DefinitelyJoinPoint{} -- Common: Regular join point. No wrapper + = [] + +tryJoinPointWW :: InScopeSet -> Type -> InBndr -> InExpr -> Maybe (InBndr, InExpr, [(InBndr, InExpr)]) +tryJoinPointWW in_scope body_ty b r + | Just ([(b', r')], wrappers) <- tryJoinPointWWs in_scope body_ty [(b, r)] + = ASSERT( wrappers `lengthAtMost` 1 ) + Just (b', r', wrappers) + | otherwise + = Nothing -simple_opt_bind env (Rec prs) top_level - = (env'', res_bind) +pair_to_non_rec + :: (SimpleOptEnv, Maybe (OutBndr, OutExpr)) + -> (SimpleOptEnv, Maybe OutBind) +pair_to_non_rec (env, mb_pr) = (env, uncurry NonRec <$> mb_pr) + +simple_opt_local_bind + :: SimpleOptEnv -> Type -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_local_bind env body_ty (NonRec b r) + | (b', r', wrappers) <- tryJoinPointWW (substInScope (soe_subst env) `extendInScopeSet` b) body_ty b r `orElse` (b, r, []) + -- , null wrappers || pprTrace "simple_opt_local_bind:join" (ppr b <+> ppr (idType b) <+> ppr body_ty) True + = -- pprTraceWith "simple_opt_local_bind" (\(env', mb_bind) -> ppr b <+> (case mb_bind of Nothing -> text "inlined" $$ ppr env'; Just _ -> text "not inlined")) $ + first (pre_inline_join_wrappers wrappers) + $ pair_to_non_rec + $ simple_bind_pair env b' Nothing (env,r') NotTopLevel + +simple_opt_local_bind env body_ty (Rec prs) + --- | null wrappers || pprTrace "simple_opt_local_bind:joinrec" (ppr prs <+> ppr body_ty) True + = (env3, res_bind) where - res_bind = Just (Rec (reverse rev_prs')) - prs' = joinPointBindings_maybe prs `orElse` prs - (env', bndrs') = subst_opt_bndrs env (map fst prs') - (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs') - do_pr (env, prs) ((b,r), b') + res_bind = Just (Rec (reverse rev_prs')) + (prs', wrappers) = tryJoinPointWWs (substInScope (soe_subst env)) body_ty prs `orElse` (prs, []) + (env1, bndrs') = subst_opt_bndrs env (map fst prs') + env2 = pre_inline_join_wrappers wrappers env1 + (env3, rev_prs') = foldl' simpl_pr (env2, []) (prs' `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') = (env', case mb_pr of Just pr -> pr : prs Nothing -> prs) where - (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) top_level + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) NotTopLevel + +pre_inline_join_wrappers :: [(InBndr, InExpr)] -> SimpleOptEnv -> SimpleOptEnv +pre_inline_join_wrappers binds env + = foldl' (\env (b,r) -> extendInlEnv env b (env, r)) env' binds + where + env' = extendInScopeEnv env (map fst binds) + +simple_opt_bind :: SimpleOptEnv -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_bind env (NonRec b r) + = pair_to_non_rec (simple_bind_pair env b Nothing (env,r) TopLevel) + +simple_opt_bind env (Rec prs) + = (env'', res_bind) + where + res_bind = Just (Rec (reverse rev_prs')) + (env', bndrs') = subst_opt_bndrs env (map fst prs) + (env'', rev_prs') = foldl' simpl_pr (env', []) (prs `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') + = (env', case mb_pr of + Just pr -> pr : prs + Nothing -> prs) + where + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) TopLevel ---------------------- simple_bind_pair :: SimpleOptEnv @@ -796,6 +863,27 @@ A more common case is when and again its arity increases (#15517) -} +data JoinPointHood + = DefinitelyJoinPoint + { join_bndr :: !InBndr + , join_rhs :: !InExpr } + | JoinPointAfterMono + { join_bndr :: !InBndr + , join_rhs :: !InExpr + , join_wrapper_bndr :: !InBndr + , join_wrapper_body :: !InExpr } + +data Blub + = MonoTyArg !Type + | SubstBinder !TyCoBinder + +instance Outputable Blub where + ppr (MonoTyArg ty) = text "Mono" <+> ppr ty + ppr (SubstBinder bndr) = text "Subst" <+> ppr bndr + +isNotMonoTyArg :: Blub -> Bool +isNotMonoTyArg MonoTyArg{} = False +isNotMonoTyArg _ = True -- | Returns Just (bndr,rhs) if the binding is a join point: -- If it's a JoinId, just return it @@ -806,29 +894,140 @@ and again its arity increases (#15517) -- -- Precondition: the InBndr has been occurrence-analysed, -- so its OccInfo is valid -joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr) -joinPointBinding_maybe bndr rhs - | not (isId bndr) - = Nothing - - | isJoinId bndr - = Just (bndr, rhs) - - | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) - , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs - , let str_sig = idStrictness bndr - str_arity = count isId bndrs -- Strictness demands are for Ids only - join_bndr = bndr `asJoinId` join_arity - `setIdStrictness` etaConvertStrictSig str_arity str_sig - = Just (join_bndr, mkLams bndrs body) +joinPointBindings_maybe :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe [JoinPointHood] +joinPointBindings_maybe in_scope body_type binds + = snd <$> mapAccumLM go (extendInScopeSetList in_scope (map fst binds)) binds + where + go :: InScopeSet -> (InBndr, InExpr) -> Maybe (InScopeSet, JoinPointHood) + go in_scope (bndr, rhs) + | not (isId bndr) + = Nothing + + | isJoinId bndr + = Just (in_scope, DefinitelyJoinPoint bndr rhs) + + | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) + , not (exprIsTrivial rhs) + , (lam_bndrs, rhs') <- etaExpandToJoinPoint join_arity rhs + , let eta_rhs' = mkLams lam_bndrs rhs' + , let inst_tys = matchJoinResTy join_arity (idType bndr) body_type + , let new_join_arity = count isNotMonoTyArg inst_tys -- all other + , let no_mono = new_join_arity == join_arity + , let worker_body = mk_worker_body lam_bndrs inst_tys eta_rhs' + -- we need an in-scope set as if the worker was defined inside the RHS of the wrapper (as is the case with SAT) + , let in_scope' = extendInScopeSetList in_scope lam_bndrs + , let new_bndr = uniqAway in_scope' bndr -- only used in else branch + `setIdType` exprType worker_body + , let wrapper_body = mk_wrapper_body new_bndr lam_bndrs inst_tys + , let wrapper_bndr = bndr + -- , no_mono || pprTrace "always tail called:" (vcat [ppr in_scope', ppr bndr, ppr (idType bndr), ppr body_type, ppr rhs, ppr new_bndr, ppr (exprType worker_body), ppr join_arity, ppr inst_tys, ppr new_bndr, ppr wrapper_body, ppr worker_body]) True + = Just $! if no_mono + then ( in_scope + , DefinitelyJoinPoint + { join_bndr = adjust_id_info bndr lam_bndrs join_arity + , join_rhs = eta_rhs' } ) + else ( extendInScopeSet in_scope new_bndr + , JoinPointAfterMono + { join_bndr = adjust_id_info new_bndr lam_bndrs new_join_arity + , join_rhs = worker_body + , join_wrapper_bndr = wrapper_bndr + , join_wrapper_body = wrapper_body } ) - | otherwise - = Nothing + | otherwise + = Nothing + + adjust_id_info :: InBndr -> [InBndr] -> JoinArity -> InBndr + adjust_id_info bndr lam_bndrs join_arity = zapStableUnfolding $ -- TODO: Discuss! Type errors otherwise. + let str_sig = idStrictness bndr + str_arity = count isId lam_bndrs -- Strictness demands are for Ids only + in bndr `asJoinId` join_arity + `setIdStrictness` etaConvertStrictSig str_arity str_sig + + -- WW example: result-type polymorphic join point + -- f :: forall a b. [a] -> forall c. b -> Maybe c -> [(a,c)] + -- f = + -- We want to monomorphise for (a ~ Bool) and (c ~ Char) from a join body ty + -- of [(Bool, Char)]. Then, we want to get a WW split like + -- f = \@a @b (xs :: [a]) @c b (mc :: Maybe c) -> f' @b xs b mc + -- f' :: forall b. [Bool] -> b -> Maybe Char -> [(Bool, Char)] + -- f' = \@b (xs :: [Bool]) b mb -> @Bool @b xs @Char b mb + -- the RHS of f is ill-typed... But after pre-inlining, we will be fine! + -- The inliner is carrying out the necessary transformation, so to speak, + -- it's not like a regular inlining decision. + + mk_wrapper_body :: InBndr -> [InBndr] -> [Blub] -> InExpr + mk_wrapper_body new_bndr lam_bndrs inst_tys + = ASSERT( lam_bndrs `equalLength` inst_tys ) + -- pprTraceWith "mk_wrapper_body" (\e -> ppr lam_bndrs $$ ppr inst_tys $$ ppr e) $ + go (Var new_bndr) $ zipEqual "mk_wrapper_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder{}):prs) -- non-instantiated parameter + | isId lb -- value paramater xs + = Lam lb (go (App e (Var lb)) prs) + | otherwise -- type paramater @b + = Lam lb (go (App e (Type (mkTyVarTy lb))) prs) + go e ((lb,MonoTyArg{}):prs) -- instantiated parameter, @a or @c + = ASSERT( isTyVar lb ) + Lam lb (go e prs) + + mk_worker_body :: [InBndr] -> [Blub] -> InExpr -> InExpr + mk_worker_body lam_bndrs inst_tys rhs + = -- pprTraceWith "mk_worker_body" (\e -> ppr e) $ + go rhs $ zipEqual "mk_worker_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder bndr):prs) -- non-instantiated parameter + | Anon _ (Scaled _ ty) <- bndr -- value paramater xs + , let lb' = lb `setIdType` ty + = Lam lb' (go (App e (Var lb')) prs) + | Named (binderVar -> tcv) <- bndr -- type paramater @b + = Lam tcv (go (App e (Type (mkTyVarTy tcv))) prs) + go e ((_ ,MonoTyArg ty):prs) -- instantiated paramater, @a or @c + = go (App e (Type ty)) prs + +-- | Figures out how to monomorphise the result type of a join point. +-- +-- @matchJoinResTy ja join_ty body_ty@ computes the result type of @join_ty@ by +-- skipping @ja@ binders and then matches it against @body_ty at . +-- If a forall binder @a@ is mentioned in the resulting substitution @subst@, +-- the corresponding entry in the returned list is @Just (subst a)@. +-- +-- Postcondition: The returned list has length @ja at . +matchJoinResTy + :: JoinArity -- ^ Number of binders to skip + -> Type -- ^ Type of the join point + -> Type -- ^ Type of the join body + -> [Blub] -- ^ An entry for each join binder, Just ty <=> instantiates + -- corresponding forall to ty +matchJoinResTy orig_ar orig_ty body_ty = snd (go init_in_scope orig_ar orig_ty) + where + init_in_scope = mkInScopeSet $ tyCoVarsOfType body_ty `unionVarSet` tyCoVarsOfType orig_ty -joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)] -joinPointBindings_maybe bndrs - = mapM (uncurry joinPointBinding_maybe) bndrs + go :: InScopeSet -> Int -> Type -> (TCvSubst, [Blub]) + go in_scope 0 res_ty = (TCvSubst in_scope tvs cvs, []) + where + TCvSubst _ tvs cvs = expectJust "matchJoinResTy" $ tcMatchTy res_ty body_ty + + go in_scope n ty + | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty + = case arg_bndr of + Anon f (Scaled m ty) + | (subst, inst_tys) <- go in_scope (n-1) res_ty + -> (subst, SubstBinder (Anon f (Scaled m (Type.substTy subst ty))):inst_tys) + Named (Bndr tcv vis) + | isTyVar tcv', Just ty <- lookupTyVar subst tcv' + -> (subst', MonoTyArg ty: inst_tys) + | otherwise + -> (subst', SubstBinder (Named (Bndr subst_tcv vis)) : inst_tys) + where + tcv' = uniqAway in_scope tcv + in_scope' = extendInScopeSet in_scope tcv' + (subst, inst_tys) = go in_scope' (n-1) res_ty + subst' = delTCvSubst subst tcv' + subst_tcv = tcv' `setVarType` Type.substTy subst' (varType tcv') + go _ _ _ = pprPanic "matchJoinResTy" (ppr orig_ar <+> ppr orig_ty) {- ********************************************************************* * * @@ -1342,5 +1541,3 @@ exprIsLambda_maybe (in_scope_set, id_unf) e exprIsLambda_maybe _ _e = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e]) Nothing - - ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Core.TyCo.Subst getTvSubstEnv, getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs, isInScope, notElemTCvSubst, - setTvSubstEnv, setCvSubstEnv, zapTCvSubst, + setTvSubstEnv, setCvSubstEnv, zapTCvSubst, delTCvSubst, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendTCvSubstWithClone, extendCvSubst, extendCvSubstWithClone, @@ -308,6 +308,23 @@ setCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv zapTCvSubst :: TCvSubst -> TCvSubst zapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv +delTCvSubst :: TCvSubst -> Var -> TCvSubst +delTCvSubst subst v + | isTyVar v + = delTvSubst subst v + | isCoVar v + = delCvSubst subst v + | otherwise + = pprPanic "delTCvSubst" (ppr v) + +delTvSubst :: TCvSubst -> TyVar -> TCvSubst +delTvSubst (TCvSubst in_scope tenv cenv) tv + = TCvSubst in_scope (delVarEnv tenv tv) cenv + +delCvSubst :: TCvSubst -> CoVar -> TCvSubst +delCvSubst (TCvSubst in_scope tenv cenv) cv + = TCvSubst in_scope tenv (delVarEnv cenv cv) + extendTCvInScope :: TCvSubst -> Var -> TCvSubst extendTCvInScope (TCvSubst in_scope tenv cenv) var = TCvSubst (extendInScopeSet in_scope var) tenv cenv ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -193,7 +193,7 @@ module GHC.Core.Type ( zipTCvSubst, notElemTCvSubst, getTvSubstEnv, setTvSubstEnv, - zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs, + zapTCvSubst, delTCvSubst, getTCvInScope, getTCvSubstRangeFVs, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendCvSubst, extendTvSubst, extendTvSubstBinderAndInScope, ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -276,7 +276,7 @@ applyTypeToArgs e op_ty args go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args go op_ty (_ : args) | Just (_, _, res_ty) <- splitFunTy_maybe op_ty = go res_ty args - go _ args = pprPanic "applyTypeToArgs" (panic_msg args) + go op_ty args = pprPanic "applyTypeToArgs" (panic_msg op_ty args) -- go_ty_args: accumulate type arguments so we can -- instantiate all at once with piResultTys @@ -287,8 +287,9 @@ applyTypeToArgs e op_ty args go_ty_args op_ty rev_tys args = go (piResultTys op_ty (reverse rev_tys)) args - panic_msg as = vcat [ text "Expression:" <+> pprCoreExpr e + panic_msg ot as = vcat [ text "Expression:" <+> pprCoreExpr e , text "Type:" <+> ppr op_ty + , text "Type':" <+> ppr ot , text "Args:" <+> ppr args , text "Args':" <+> ppr as ] @@ -2622,4 +2623,3 @@ isUnsafeEqualityProof e = idName v == unsafeEqualityProofName | otherwise = False - ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Driver.Ppr , pprTraceWithFlags , pprTraceM , pprTraceDebug + , pprTraceWith , pprTraceIt , pprSTrace , pprTraceException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee89bb7b0a39644d9455af61204fd85eddce0e23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee89bb7b0a39644d9455af61204fd85eddce0e23 You're receiving 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 22 16:05:21 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 22 Sep 2020 12:05:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18708 Message-ID: <5f6a20c1ecad_80b3f8455952374137156b4@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18708 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18708 You're receiving 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 22 19:23:48 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 22 Sep 2020 15:23:48 -0400 Subject: [Git][ghc/ghc][wip/T18528] 238 commits: Refactor CLabel pretty-printing Message-ID: <5f6a4f44c15fb_80b3f841f1a493c137574e0@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/T18528 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 045ab6ab by Richard Eisenberg at 2020-09-22T15:10:49-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. - - - - - 27 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - README.md - 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/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.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/f76f60eee607a2db1c4e312546b6ce29780d9dd7...045ab6ab8dc85543abee1c7a3e7f212f0070023a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f76f60eee607a2db1c4e312546b6ce29780d9dd7...045ab6ab8dc85543abee1c7a3e7f212f0070023a You're receiving 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 22 19:48:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 22 Sep 2020 15:48:38 -0400 Subject: [Git][ghc/ghc][wip/T18126] 12 commits: docs: correct haddock reference Message-ID: <5f6a5516113d5_80bab05c34137765de@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 62981125 by Simon Peyton Jones at 2020-09-22T15:47:39-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 92548dd6 by Simon Peyton Jones at 2020-09-22T15:47:39-04: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 - - - - - bfa09966 by Ben Gamari at 2020-09-22T15:47:39-04:00 Use UniqSet for FieldLabelString instead of Data.Set FieldLabelString, which is a FastString, no longer has an Ord instance. - - - - - 23 changed files: - README.md - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/DmdAnal.hs - 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/Iface/Type.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/5917ddbaa257e7a47a95e37c73f3e6a730aa01bd...bfa0996647bdaf55228659b00125220a76ba0d4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5917ddbaa257e7a47a95e37c73f3e6a730aa01bd...bfa0996647bdaf55228659b00125220a76ba0d4c You're receiving 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 22 20:21:43 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 22 Sep 2020 16:21:43 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Proof of Concept implementation of in-tree API Annotations Message-ID: <5f6a5cd78040b_80b3f8435f5a2141379426a@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: e6ea932f by Alan Zimmerman at 2020-09-20T23:15:32+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 Remove LHsLocalBinds 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. - - - - - 19 changed files: - .gitmodules - compiler/GHC.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ea932fa8e64fdce493ed74886b4e276d723e16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ea932fa8e64fdce493ed74886b4e276d723e16 You're receiving 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 22 21:05:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 22 Sep 2020 17:05:58 -0400 Subject: [Git][ghc/ghc][wip/backports] gitlab-ci: Ensure that cabal-install overwrites existing executables Message-ID: <5f6a67361efcb_80bd814cfc138175b4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: d4d44edb by Ben Gamari at 2020-09-22T17:05:52-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). (cherry picked from commit 2f7ef2fb3234cdfb89b3da1298fc9c1b7381e418) - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -282,7 +282,12 @@ 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 \ + --index-state=$hackage_index_state \ + --installdir=$toolchain/bin \ + --overwrite-policy=always" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd You're receiving 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 22 21:12:03 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 22 Sep 2020 17:12:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Better eta-expansion (again) and don't specilise DFuns Message-ID: <5f6a68a3268a5_80b3f848671a9a41382181d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 63ef941a by Hécate at 2020-09-22T17:11:54-04:00 Remove the list of loaded modules from the ghci prompt - - - - - 0a217d1d by Ben Gamari at 2020-09-22T17:11:54-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 19 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9abf8daca866c326195586a19be3477a5d0a0d4...0a217d1de3de01168b33e2dde05dcc6e5ffef6c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9abf8daca866c326195586a19be3477a5d0a0d4...0a217d1de3de01168b33e2dde05dcc6e5ffef6c2 You're receiving 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 22 21:43:27 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 22 Sep 2020 17:43:27 -0400 Subject: [Git][ghc/ghc][wip/T18723] WIP: Check for large tuples more thoroughly in the typechecker Message-ID: <5f6a6fff9c22b_80baa689ac1383423d@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T18723 at Glasgow Haskell Compiler / GHC Commits: f01bf042 by Ryan Scott at 2020-09-22T17:42:23-04:00 WIP: Check for large tuples more thoroughly in the typechecker This unifies the treatment of how GHC checks for constraint tuples and other tuples by: * Migrating the `checkTupSize` renamer check to the typechecker, * Moving the existing `bigConstraintTuple` typechecker validity check to `checkCTupSize` for consistency with `checkTupSize`, and * Consistently using `check(C)TupSize` when typechecking tuple names, expressions, patterns, and types. * Removing the unused `HsConstraintTuple` constructor of `HsTupleSort`. Fixes #18723. - - - - - 25 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - testsuite/tests/polykinds/T10451.stderr - − testsuite/tests/rename/should_fail/T6148.stderr - + testsuite/tests/rename/should_fail/T6148a.hs - + testsuite/tests/rename/should_fail/T6148a.stderr - + testsuite/tests/rename/should_fail/T6148b.hs - + testsuite/tests/rename/should_fail/T6148b.stderr - testsuite/tests/rename/should_fail/T6148.hs → testsuite/tests/rename/should_fail/T6148c.hs - + testsuite/tests/rename/should_fail/T6148c.stderr - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/typecheck/should_fail/T18723a.hs - + testsuite/tests/typecheck/should_fail/T18723a.stderr - + testsuite/tests/typecheck/should_fail/T18723b.hs - + testsuite/tests/typecheck/should_fail/T18723b.stderr - + testsuite/tests/typecheck/should_fail/T18723c.hs - + testsuite/tests/typecheck/should_fail/T18723c.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -1061,16 +1061,17 @@ four constructors of HsTupleSort: HsUnboxedTuple -> Produced by the parser HsBoxedTuple -> Certainly a boxed tuple - HsConstraintTuple -> Certainly a constraint tuple HsBoxedOrConstraintTuple -> Could be a boxed or a constraint tuple. Produced by the parser only, disappears after type checking + +After typechecking, we use TupleSort (which clearly distinguishes between +constraint tuples and boxed tuples) rather than HsTupleSort. -} -- | Haskell Tuple Sort data HsTupleSort = HsUnboxedTuple | HsBoxedTuple - | HsConstraintTuple | HsBoxedOrConstraintTuple deriving Data @@ -1985,11 +1986,10 @@ hsTypeNeedsParens p = go_hs_ty -- Special-case unary boxed tuple applications so that they are -- parenthesized as `Identity (Solo x)`, not `Identity Solo x` (#18612) -- See Note [One-tuples] in GHC.Builtin.Types - go_hs_ty (HsTupleTy _ con [L _ ty]) + go_hs_ty (HsTupleTy _ con [_]) = case con of HsBoxedTuple -> p >= appPrec HsBoxedOrConstraintTuple -> p >= appPrec - HsConstraintTuple -> go_hs_ty ty HsUnboxedTuple -> False go_hs_ty (HsTupleTy{}) = False go_hs_ty (HsSumTy{}) = False ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Iface.Load ( -- Importing one thing tcLookupImported_maybe, importDecl, checkWiredInTyCon, ifCheckWiredInThing, + checkTupSize, checkCTupSize, -- RnM/TcM functions loadModuleInterface, loadModuleInterfaces, @@ -56,6 +57,8 @@ import GHC.Builtin.Names import GHC.Builtin.Utils import GHC.Builtin.PrimOps ( allThePrimOps, primOpFixity, primOpOcc ) import GHC.Types.Id.Make ( seqId, EnableBignumRules(..) ) +import GHC.Core.ConLike +import GHC.Core.DataCon import GHC.Core.Rules import GHC.Core.TyCon import GHC.Types.Annotations @@ -78,7 +81,6 @@ import GHC.Utils.Misc import GHC.Data.FastString import GHC.Utils.Fingerprint import GHC.Driver.Hooks -import GHC.Types.FieldLabel import GHC.Iface.Rename import GHC.Types.Unique.DSet import GHC.Driver.Plugins @@ -133,9 +135,30 @@ tcImportDecl_maybe name = do { when (needWiredInHomeIface thing) (initIfaceTcRn (loadWiredInHomeIface name)) -- See Note [Loading instances for wired-in things] + -- Error if attempting to use a prefix tuple name (,, ... ,,) that + -- exceeds mAX_TUPLE_SIZE. + ; whenIsJust (tuple_ty_thing_maybe thing) checkTupSize ; return (Succeeded thing) } | otherwise = initIfaceTcRn (importDecl name) + where + -- Returns @Just arity@ if the supplied TyThing corresponds to a tuple + -- type or data constructor. Returns @Nothing@ otherwise. + tuple_ty_thing_maybe :: TyThing -> Maybe Arity + tuple_ty_thing_maybe thing + | Just tycon <- case thing of + ATyCon tc -> Just tc + AConLike (RealDataCon dc) -> Just (dataConTyCon dc) + _ -> Nothing + , Just tupleSort <- tyConTuple_maybe tycon + = Just $ case tupleSort of + -- Unboxed tuples have twice as many arguments because of the + -- 'RuntimeRep's (#17837) + UnboxedTuple -> tyConArity tycon `div` 2 + _ -> tyConArity tycon + + | otherwise + = Nothing importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing) -- Get the TyThing for this Name from an interface file @@ -249,6 +272,27 @@ needWiredInHomeIface :: TyThing -> Bool needWiredInHomeIface (ATyCon {}) = True needWiredInHomeIface _ = False +-- | Ensure that a boxed or unboxed tuple has arity no larger than +-- 'mAX_TUPLE_SIZE'. +checkTupSize :: Int -> TcM () +checkTupSize tup_size + | tup_size <= mAX_TUPLE_SIZE + = return () + | otherwise + = addErr (sep [text "A" <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), + nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), + nest 2 (text "Workaround: use nested tuples or define a data type")]) + +-- | Ensure that a constraint tuple has arity no larger than 'mAX_CTUPLE_SIZE'. +checkCTupSize :: Int -> TcM () +checkCTupSize tup_size + | tup_size <= mAX_CTUPLE_SIZE + = return () + | otherwise + = addErr (hang (text "Constraint tuple arity too large:" <+> int tup_size + <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) + 2 (text "Instead, use a nested tuple")) + {- ************************************************************************ ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Utils.Error ( MsgDoc ) import GHC.Builtin.Names( rOOT_MAIN ) -import GHC.Types.Basic ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) ) +import GHC.Types.Basic ( pprWarningTxtForMsg, TopLevelFlag(..) ) import GHC.Types.SrcLoc as SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Types.Unique.Set ( uniqSetAny ) @@ -278,20 +278,6 @@ lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn -- Note [Errors in lookup functions] lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name) lookupExactOcc_either name - | Just thing <- wiredInNameTyThing_maybe name - , Just tycon <- case thing of - ATyCon tc -> Just tc - AConLike (RealDataCon dc) -> Just (dataConTyCon dc) - _ -> Nothing - , Just tupleSort <- tyConTuple_maybe tycon - = do { let tupArity = case tupleSort of - -- Unboxed tuples have twice as many arguments because of the - -- 'RuntimeRep's (#17837) - UnboxedTuple -> tyConArity tycon `div` 2 - _ -> tyConArity tycon - ; checkTupSize tupArity - ; return (Right name) } - | isExternalName name = return (Right name) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -282,7 +282,6 @@ rnExpr (ExplicitList x _ exps) rnExpr (ExplicitTuple x tup_args boxity) = do { checkTupleSection tup_args - ; checkTupSize (length tup_args) ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args ; return (ExplicitTuple x tup_args' boxity, plusFVs fvs) } where ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -38,8 +38,8 @@ module GHC.Rename.Pat (-- main entry points -- Literals rnLit, rnOverLit, - -- Pattern Error messages that are also used elsewhere - checkTupSize, patSigErr + -- Pattern Error message that is also used elsewhere + patSigErr ) where -- ENH: thin imports to only what is necessary for patterns @@ -60,7 +60,7 @@ import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames , warnUnusedMatches, newLocalBndrRn , checkUnusedRecordWildcard , checkDupNames, checkDupAndShadowedNames - , checkTupSize , unknownSubordinateErr ) + , unknownSubordinateErr ) import GHC.Rename.HsType import GHC.Builtin.Names import GHC.Types.Name @@ -498,8 +498,7 @@ rnPatAndThen mk (ListPat _ pats) False -> return (ListPat Nothing pats') } rnPatAndThen mk (TuplePat x pats boxed) - = do { liftCps $ checkTupSize (length pats) - ; pats' <- rnLPatsAndThen mk pats + = do { pats' <- rnLPatsAndThen mk pats ; return (TuplePat x pats' boxed) } rnPatAndThen mk (SumPat x pat alt arity) ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -12,7 +12,6 @@ This module contains miscellaneous functions related to renaming. module GHC.Rename.Utils ( checkDupRdrNames, checkShadowedRdrNames, checkDupNames, checkDupAndShadowedNames, dupNamesErr, - checkTupSize, addFvRn, mapFvRn, mapMaybeFvRn, warnUnusedMatches, warnUnusedTypePatterns, warnUnusedTopBinds, warnUnusedLocalBinds, @@ -58,7 +57,6 @@ import GHC.Driver.Session import GHC.Data.FastString import Control.Monad import Data.List -import GHC.Settings.Constants ( mAX_TUPLE_SIZE ) import qualified Data.List.NonEmpty as NE import qualified GHC.LanguageExtensions as LangExt @@ -573,15 +571,6 @@ typeAppErr what (L _ k) <+> quotes (char '@' <> ppr k)) 2 (text "Perhaps you intended to use TypeApplications") -checkTupSize :: Int -> RnM () -checkTupSize tup_size - | tup_size <= mAX_TUPLE_SIZE - = return () - | otherwise - = addErr (sep [text "A" <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), - nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), - nest 2 (text "Workaround: use nested tuples or define a data type")]) - {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -31,6 +31,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntyp import GHC.Builtin.Names.TH( liftStringName, liftName ) import GHC.Hs +import GHC.Iface.Load import GHC.Tc.Utils.Zonk import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Unify @@ -1548,7 +1549,9 @@ tcArg fun arg (Scaled mult ty) arg_no ---------------- tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc] tcTupArgs args tys - = ASSERT( equalLength args tys ) mapM go (args `zip` tys) + = do MASSERT( equalLength args tys ) + checkTupSize (length args) + mapM go (args `zip` tys) where go (L l (Missing {}), arg_ty) = do { mult <- newFlexiTyVarTy multiplicityTy ; return (L l (Missing (Scaled mult arg_ty))) } ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -83,6 +83,7 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Validity import GHC.Tc.Utils.Unify import GHC.IfaceToCore +import GHC.Iface.Load import GHC.Tc.Solver import GHC.Tc.Utils.Zonk import GHC.Core.TyCo.Rep @@ -106,8 +107,6 @@ import GHC.Types.Var.Env import GHC.Builtin.Types import GHC.Types.Basic import GHC.Types.SrcLoc -import GHC.Settings.Constants ( mAX_CTUPLE_SIZE ) -import GHC.Utils.Error( MsgDoc ) import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set @@ -1078,7 +1077,6 @@ tc_hs_type mode rn_ty@(HsTupleTy _ hs_tup_sort tys) exp_kind tup_sort = case hs_tup_sort of -- Fourth case dealt with above HsUnboxedTuple -> UnboxedTuple HsBoxedTuple -> BoxedTuple - HsConstraintTuple -> ConstraintTuple #if __GLASGOW_HASKELL__ <= 810 _ -> panic "tc_hs_type HsTupleTy" #endif @@ -1112,6 +1110,7 @@ tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind ; let kind_con = tupleTyCon Boxed arity ty_con = promotedTupleDataCon Boxed arity tup_k = mkTyConApp kind_con ks + ; checkTupSize arity ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind } where arity = length tys @@ -1266,33 +1265,28 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do -- Drop any uses of 1-tuple constraints here. -- See Note [Ignore unary constraint tuples] -> check_expected_kind tau_ty constraintKind - | arity > mAX_CTUPLE_SIZE - -> failWith (bigConstraintTuple arity) | otherwise - -> let tycon = cTupleTyCon arity in - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> do let tycon = cTupleTyCon arity + checkCTupSize arity + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity + checkTupSize arity checkWiredInTyCon tycon check_expected_kind (mkTyConApp tycon tau_tys) liftedTypeKind - UnboxedTuple -> + UnboxedTuple -> do let tycon = tupleTyCon Unboxed arity tau_reps = map kindRep tau_kinds -- See also Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon arg_tys = tau_reps ++ tau_tys - res_kind = unboxedTupleKind tau_reps in + res_kind = unboxedTupleKind tau_reps + checkTupSize arity check_expected_kind (mkTyConApp tycon arg_tys) res_kind where arity = length tau_tys check_expected_kind ty act_kind = checkExpectedKind rn_ty ty act_kind exp_kind -bigConstraintTuple :: Arity -> MsgDoc -bigConstraintTuple arity - = hang (text "Constraint tuple arity too large:" <+> int arity - <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) - 2 (text "Instead, use a nested tuple") - {- Note [Ignore unary constraint tuples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho ) import GHC.Hs +import GHC.Iface.Load import GHC.Tc.Utils.Zonk import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags ) import GHC.Tc.Utils.Monad @@ -511,6 +512,7 @@ Fortunately that's what matchExpectedFunTySigma returns anyway. tc = tupleTyCon boxity arity -- NB: tupleTyCon does not flatten 1-tuples -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make + ; checkTupSize arity ; (coi, arg_tys) <- matchExpectedPatTy (matchExpectedTyConApp tc) penv (scaledThing pat_ty) -- Unboxed tuples have RuntimeRep vars, which we discard: ===================================== testsuite/tests/polykinds/T10451.stderr ===================================== @@ -1,11 +1,12 @@ T10451.hs:22:12: error: - Constraint tuple arity too large: 64 (max arity = 62) - Instead, use a nested tuple - In the type ‘(Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, - Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a)’ - In the type declaration for ‘T’ + • Constraint tuple arity too large: 64 (max arity = 62) + Instead, use a nested tuple + • In the type ‘(Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, Eq a, + Eq a)’ + In the type declaration for ‘T’ ===================================== testsuite/tests/rename/should_fail/T6148.stderr deleted ===================================== @@ -1,15 +0,0 @@ - -T6148.hs:3:5: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type - -T6148.hs:7:5: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type - -T6148.hs:11:6: - A 63-tuple is too large for GHC - (max size is 62) - Workaround: use nested tuples or define a data type ===================================== testsuite/tests/rename/should_fail/T6148a.hs ===================================== @@ -0,0 +1,4 @@ +module T6148a where + +a = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ===================================== testsuite/tests/rename/should_fail/T6148a.stderr ===================================== @@ -0,0 +1,13 @@ + +T6148a.hs:3:5: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the expression: + (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + In an equation for ‘a’: + a = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ===================================== testsuite/tests/rename/should_fail/T6148b.hs ===================================== @@ -0,0 +1,3 @@ +module T6148b where + +b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) ===================================== testsuite/tests/rename/should_fail/T6148b.stderr ===================================== @@ -0,0 +1,9 @@ + +T6148b.hs:3:5: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the expression: + (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) + In an equation for ‘b’: + b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) ===================================== testsuite/tests/rename/should_fail/T6148.hs → testsuite/tests/rename/should_fail/T6148c.hs ===================================== @@ -1,14 +1,8 @@ -module T6148 where - -a = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) - - -b = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) +module T6148c where data T = T -c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) +c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T ===================================== testsuite/tests/rename/should_fail/T6148c.stderr ===================================== @@ -0,0 +1,7 @@ + +T6148c.hs:5:6: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type signature: + c :: (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T T ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -87,7 +87,9 @@ test('T5892b', normal, compile_fail, ['-package containers']) test('T5951', normal, compile_fail, ['']) test('T6018rnfail', normal, compile_fail, ['']) test('T6060', normal, compile_fail, ['']) -test('T6148', normal, compile_fail, ['']) +test('T6148a', normal, compile_fail, ['']) +test('T6148b', normal, compile_fail, ['']) +test('T6148c', normal, compile_fail, ['']) test('T7164', normal, compile_fail, ['']) test('T7338', normal, compile_fail, ['']) test('T7338a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18723a.hs ===================================== @@ -0,0 +1,11 @@ +module T18723a where + +data T1 = MkT1 + ( Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + ) ===================================== testsuite/tests/typecheck/should_fail/T18723a.stderr ===================================== @@ -0,0 +1,13 @@ + +T18723a.hs:4:3: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type ‘(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int)’ + In the definition of data constructor ‘MkT1’ + In the data declaration for ‘T1’ ===================================== testsuite/tests/typecheck/should_fail/T18723b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +module T18723b where + +import Data.Proxy + +data T2 = MkT2 (Proxy + '( Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + )) ===================================== testsuite/tests/typecheck/should_fail/T18723b.stderr ===================================== @@ -0,0 +1,133 @@ + +T18723b.hs:7:2: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the first argument of ‘Proxy’, namely + ‘'(Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int)’ + In the type ‘(Proxy '(Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int, + Int))’ + In the definition of data constructor ‘MkT2’ ===================================== testsuite/tests/typecheck/should_fail/T18723c.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE UnboxedTuples #-} +module T18723c where + +data T3 = MkT3 + (# Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int, Int, Int, Int, Int, Int, Int, Int + , Int, Int, Int + #) ===================================== testsuite/tests/typecheck/should_fail/T18723c.stderr ===================================== @@ -0,0 +1,13 @@ + +T18723c.hs:5:2: error: + • A 63-tuple is too large for GHC + (max size is 62) + Workaround: use nested tuples or define a data type + • In the type ‘(# Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, + Int #)’ + In the definition of data constructor ‘MkT3’ + In the data declaration for ‘T3’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -579,3 +579,6 @@ test('T18357a', normal, compile_fail, ['']) test('T18357b', normal, compile_fail, ['']) test('T18455', normal, compile_fail, ['']) test('T18534', normal, compile_fail, ['']) +test('T18723a', normal, compile_fail, ['']) +test('T18723b', normal, compile_fail, ['']) +test('T18723c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f01bf042179e00c1884cffc4f2cf2b93f58821ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f01bf042179e00c1884cffc4f2cf2b93f58821ef You're receiving 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 22 21:48:12 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 22 Sep 2020 17:48:12 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 3 commits: Fix list_threads_and_misc_roots test Message-ID: <5f6a711c7dee_80b3f84105f4e6013837954@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: d5c177c6 by David Eichmann at 2020-09-22T13:32:12+01:00 Fix list_threads_and_misc_roots test - - - - - deb2ee4b by David Eichmann at 2020-09-22T14:31:22+01:00 Allow rts_pause to be called multiple times from the same thread - - - - - 6e7134f5 by David Eichmann at 2020-09-22T22:47:58+01:00 Return a Capability from rts_pause to allow use of other RtsAPI.h functions - - - - - 9 changed files: - includes/RtsAPI.h - libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c - rts/RtsAPI.c - testsuite/tests/rts/ghc-debug/all.T - testsuite/tests/rts/ghc-debug/ghc_debug.c - testsuite/tests/rts/ghc-debug/ghc_debug.h - + testsuite/tests/rts/ghc-debug/ghc_debug_03.stdout - + testsuite/tests/rts/ghc-debug/ghc_debug_04.hs - + testsuite/tests/rts/ghc-debug/ghc_debug_04.stdout Changes: ===================================== includes/RtsAPI.h ===================================== @@ -335,11 +335,12 @@ extern void (*exitFn)(int); /* ---------------------------------------------------------------------------- Locking. - You have to surround all access to the RtsAPI with these calls. + You have to surround all access to the RtsAPI with rts_lock and rts_unlock + or with rts_pause and rts_resume. ------------------------------------------------------------------------- */ -// acquires a token which may be used to create new objects and -// evaluate them. +// acquires a token which may be used to create new objects and evaluate them. +// Calling rts_lock in between rts_pause/rts_resume will cause a deadlock. Capability *rts_lock (void); // releases the token acquired with rts_lock(). @@ -485,28 +486,34 @@ void rts_checkSchedStatus (char* site, Capability *); SchedulerStatus rts_getSchedStatus (Capability *cap); -// Halt execution of all Haskell threads (OS threads may continue) by acquiring -// all capabilities. Blocks untill pausing is completed. This is different to -// rts_lock() because rts_pause() pauses all capabilities while rts_lock() only -// pauses a single capability. rts_pause() and rts_resume() must be executed -// from the same OS thread. Must not be called when the rts is already paused. -void rts_pause (void); +// Halt execution of all Haskell threads by acquiring all capabilities (safe FFI +// calls may continue). rts_resume() must later be called on the same thread to +// resume the RTS. Only one thread at a time can keep the rts paused. The +// rts_pause function will block until the current thread is given exclusive +// permission to pause the RTS. If the RTS was already paused by the current OS +// thread, then rts_pause will return immediately and have no effect. Returns a +// token which may be used to create new objects and evaluate them (like +// rts_lock) .This is different to rts_lock() which only pauses a single +// capability. Calling rts_pause in between rts_lock/rts_unlock will cause a +// deadlock. +Capability * rts_pause (void); // Counterpart of rts_pause: Continue from a pause. All capabilities are // released. Must be done while RTS is paused and on the same thread as // rts_pause(). -void rts_resume (void); +// [in] cap: the token returned by rts_pause. +void rts_resume (Capability * cap); // Tells the current state of the RTS regarding rts_pause() and rts_resume(). bool rts_isPaused(void); // List all live threads. Must be done while RTS is paused and on the same -// thread as rts_pause(). +// thread that called rts_pause(). typedef void (*ListThreadsCb)(void *user, StgTSO *); void rts_listThreads(ListThreadsCb cb, void *user); -// List all non-thread GC roots. Must be done while RTS is paused (see -// rts_pause()). +// List all non-thread GC roots. Must be done while RTS is paused on the same +// thread that called rts_pause(). typedef void (*ListRootsCb)(void *user, StgClosure *); void rts_listMiscRoots(ListRootsCb cb, void *user); ===================================== libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c ===================================== @@ -23,10 +23,10 @@ void collectMiscRootsCallback(void *user, StgClosure* closure){ } void* listThreads_thread(void* unused){ - RtsPaused paused = rts_pause(); + Capability * cap = rts_pause(); rts_listThreads(&collectTSOsCallback, NULL); rts_listMiscRoots(&collectMiscRootsCallback, NULL); - rts_resume(paused); + rts_resume(cap); return NULL; } ===================================== rts/RtsAPI.c ===================================== @@ -652,8 +652,15 @@ rts_unlock (Capability *cap) Task * rts_pausing_task = NULL; // See RtsAPI.h -void rts_pause (void) +Capability * rts_pause (void) { + // Return immediately if this thread already paused the RTS. If another + // thread has paused the RTS, then rts_pause will block until rts_resume is + // called (and compete with other threads calling rts_pause). The blocking + // behavior is implied by the use of `stopAllCapabilities`. + Task * task = getMyTask(); + if (rts_pausing_task == task) return task->cap; + // The current task must not own a capability. This is true when a new // thread is stareted, or when making a safe FFI call. If // `task->cap->running_task == task` then that is also ok because the @@ -661,7 +668,6 @@ void rts_pause (void) // (rather than ASSERT which only happens with `-debug`) because this is a // user facing function and we want good error reporting. We also don't // expect rts_pause to be performance critical. - Task * task = getMyTask(); if (task->cap && task->cap->running_task == task) { // This task owns a capability (at it can't be taken by other capabilities). @@ -673,15 +679,6 @@ void rts_pause (void) stg_exit(EXIT_FAILURE); } - // Note that if the rts was paused by another task/thread, then we block - // instead of error. It's only an error if the same thread tries to pause - // twice in a row. - if (rts_pausing_task == task) - { - errorBelch("error: rts_pause: attempting to pause an already paused RTS."); - stg_exit(EXIT_FAILURE); - } - // NOTE ghc-debug deadlock: // // stopAllCapabilities attempts to acquire all capabilities and will only @@ -743,10 +740,13 @@ void rts_pause (void) // Now we own all capabilities so we own rts_pausing_task. rts_pausing_task = task; + + return task->cap; } -// See RtsAPI.h -void rts_resume (void) +// See RtsAPI.h The cap argument is here just for symmetry with rts_pause and to +// match the pattern of rts_lock/rts_unlock. +void rts_resume (Capability * cap STG_UNUSED) { Task * task = getMyTask(); // This thread has ownership over its Task. @@ -848,14 +848,14 @@ void rts_listMiscRoots (ListRootsCb cb, void *user) } #else -void rts_pause (void) +Capability * rts_pause (void) { errorBelch("Warning: Pausing the RTS is only possible for " "multithreaded RTS."); stg_exit(EXIT_FAILURE); } -void rts_resume (void) +void rts_resume (Capability * cap) { errorBelch("Warning: Unpausing the RTS is only possible for " "multithreaded RTS."); ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,18 +1,8 @@ -test('ghc_debug_01', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_01', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_02', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_02', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_03', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_03', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '-threaded ']) +test('ghc_debug_04', [extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], '-threaded ']) ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.c ===================================== @@ -1,3 +1,4 @@ +#include #include #include @@ -29,7 +30,17 @@ void pauseAndResume } // Pause and assert. - rts_pause(); + Capability * cap = rts_pause(); + if(cap == NULL) { + errorBelch("rts_pause() returned NULL."); + exit(1); + } + Capability * cap2 = rts_pause(); // This should have no effect and return immediately. + if(cap != cap2) { + errorBelch("A second call to rts_pause() returned a different Capability."); + exit(1); + } + if(!rts_isPaused()) { errorBelch("Expected the RTS to be paused."); exit(1); @@ -38,7 +49,7 @@ void pauseAndResume expectNoChange("RTS should be paused", count); // Resume. - rts_resume(); + rts_resume(cap); // Assert the RTS is resumed. if (assertNotPaused) @@ -51,6 +62,125 @@ void pauseAndResume } } +int addOne(int a) +{ + return a + 1; +} + +// Pause tht RTS and call all RtsAPI.h functions. +void pauseAndUseRtsAPIAndResume + ( HaskellObj haskellFn // [in] A Haskell function (StablePtr (a -> a)) + , HaskellObj haskellFnArgument // [in] An argument to apply to haskellFn (a) + , HaskellObj obj1 // [in] arbitrary haskell value to evaluate of arbitrary type. + , HaskellObj obj2 // [in] arbitrary haskell value to evaluate of arbitrary type. + , HsStablePtr stablePtrIO // [in] arbitrary haskell IO action to execute (StablePtr (IO t)) + ) +{ + // Pause the RTS. + printf("Pause the RTS..."); + Capability * cap = rts_pause(); + printf("Paused\n"); + + // Note the original capability. We assert that cap is not changed by + // functions that take &cap. + Capability *const cap0 = cap; + + // Call RtsAPI.h functions + + // TODO print out what funciton is running to give better debug output if one of these deadlocks + + printf("getRTSStats...\n"); + RTSStats s; + getRTSStats (&s); + printf("getRTSStatsEnabled...\n"); + getRTSStatsEnabled(); + printf("getAllocations...\n"); + getAllocations(); + printf("rts_getSchedStatus...\n"); + rts_getSchedStatus(cap); + printf("rts_getChar, rts_mkChar...\n"); + rts_getChar (rts_mkChar ( cap, 0 )); + printf("rts_getInt, rts_mkInt...\n"); + rts_getInt (rts_mkInt ( cap, 0 )); + printf("rts_getInt8, rts_mkInt8...\n"); + rts_getInt8 (rts_mkInt8 ( cap, 0 )); + printf("rts_getInt16, rts_mkInt16...\n"); + rts_getInt16 (rts_mkInt16 ( cap, 0 )); + printf("rts_getInt32, rts_mkInt32...\n"); + rts_getInt32 (rts_mkInt32 ( cap, 0 )); + printf("rts_getInt64, rts_mkInt64...\n"); + rts_getInt64 (rts_mkInt64 ( cap, 0 )); + printf("rts_getWord, rts_mkWord...\n"); + rts_getWord (rts_mkWord ( cap, 0 )); + printf("rts_getWord8, rts_mkWord8...\n"); + rts_getWord8 (rts_mkWord8 ( cap, 0 )); + printf("rts_getWord16, rts_mkWord16...\n"); + rts_getWord16 (rts_mkWord16 ( cap, 0 )); + printf("rts_getWord32, rts_mkWord32...\n"); + rts_getWord32 (rts_mkWord32 ( cap, 0 )); + printf("rts_getWord64, rts_mkWord64...\n"); + rts_getWord64 (rts_mkWord64 ( cap, 0 )); + printf("rts_getPtr, rts_mkPtr...\n"); + int x = 0; + rts_getPtr (rts_mkPtr ( cap, &x)); + printf("rts_getFunPtr, rts_mkFunPtr...\n"); + rts_getFunPtr (rts_mkFunPtr ( cap, &addOne )); + printf("rts_getFloat, rts_mkFloat...\n"); + rts_getFloat (rts_mkFloat ( cap, 0.0 )); + printf("rts_getDouble, rts_mkDouble...\n"); + rts_getDouble (rts_mkDouble ( cap, 0.0 )); + printf("rts_getStablePtr, rts_mkStablePtr...\n"); + rts_getStablePtr (rts_mkStablePtr ( cap, &x )); + printf("rts_getBool, rts_mkBool...\n"); + rts_getBool (rts_mkBool ( cap, 0 )); + printf("rts_mkString...\n"); + rts_mkString ( cap, "Hello ghc-debug!" ); + printf("rts_apply...\n"); + rts_apply ( cap, deRefStablePtr(haskellFn), haskellFnArgument ); + + printf("rts_eval...\n"); + HaskellObj ret; + rts_eval(&cap, obj1, &ret); + assert(cap == cap0); + + printf("rts_eval_...\n"); + rts_eval_ (&cap, obj2, 50, &ret); + assert(cap == cap0); + + printf("rts_evalIO...\n"); + HaskellObj io = deRefStablePtr(stablePtrIO); + rts_evalIO (&cap, io, &ret); + assert(cap == cap0); + + printf("rts_evalStableIOMain...\n"); + HsStablePtr retStablePtr; + rts_evalStableIOMain (&cap, stablePtrIO, &retStablePtr); + assert(cap == cap0); + + printf("rts_evalStableIO...\n"); + rts_evalStableIO (&cap, stablePtrIO, &retStablePtr); + assert(cap == cap0); + + printf("rts_evalLazyIO...\n"); + rts_evalLazyIO (&cap, io, &ret); + assert(cap == cap0); + + printf("rts_evalLazyIO_...\n"); + rts_evalLazyIO_ (&cap, io, 50, &ret); + assert(cap == cap0); + + printf("rts_setInCallCapability...\n"); + rts_setInCallCapability (0, 1); + printf("rts_pinThreadToNumaNode...\n"); + rts_pinThreadToNumaNode (0); + + // Resume the RTS. + printf("Resume the RTS..."); + rts_resume(cap); + assert(cap == cap0); + printf("Resumed\n"); +} + void* pauseAndResumeViaThread_helper(volatile unsigned int * count) { pauseAndResume(false, count); ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.h ===================================== @@ -1,3 +1,10 @@ void pauseAndResume(bool assertNotPaused, volatile unsigned int * count); unsigned long pauseAndResumeViaThread(volatile unsigned int * count); +void pauseAndUseRtsAPIAndResume + ( HaskellObj haskellFn + , HaskellObj haskellFnArgument + , HaskellObj obj1 + , HaskellObj obj2 + , HsStablePtr stablePtrIO + ); \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_03.stdout ===================================== @@ -0,0 +1 @@ +All threads finished ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_04.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Foreign +import System.Exit +import System.Timeout + +foreign import ccall safe "ghc_debug.h pauseAndUseRtsAPIAndResume" + pauseAndUseRtsAPIAndResume + :: (StablePtr (Int -> Int)) + -> Int + -> Int + -> Int + -> (StablePtr (IO Int)) + -> IO () + +main :: IO () +main = do + addOne <- newStablePtr ((+1) :: Int -> Int) + ioOne <- newStablePtr (return 1 :: IO Int) + successMay <- timeout 5000000 $ pauseAndUseRtsAPIAndResume + addOne + 1 + 2 + 3 + ioOne + case successMay of + Nothing -> exitFailure + Just () -> exitSuccess ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_04.stdout ===================================== @@ -0,0 +1,34 @@ +Pause the RTS...Paused +getRTSStats... +getRTSStatsEnabled... +getAllocations... +rts_getSchedStatus... +rts_getChar, rts_mkChar... +rts_getInt, rts_mkInt... +rts_getInt8, rts_mkInt8... +rts_getInt16, rts_mkInt16... +rts_getInt32, rts_mkInt32... +rts_getInt64, rts_mkInt64... +rts_getWord, rts_mkWord... +rts_getWord8, rts_mkWord8... +rts_getWord16, rts_mkWord16... +rts_getWord32, rts_mkWord32... +rts_getWord64, rts_mkWord64... +rts_getPtr, rts_mkPtr... +rts_getFunPtr, rts_mkFunPtr... +rts_getFloat, rts_mkFloat... +rts_getDouble, rts_mkDouble... +rts_getStablePtr, rts_mkStablePtr... +rts_getBool, rts_mkBool... +rts_mkString... +rts_apply... +rts_eval... +rts_eval_... +rts_evalIO... +rts_evalStableIOMain... +rts_evalStableIO... +rts_evalLazyIO... +rts_evalLazyIO_... +rts_setInCallCapability... +rts_pinThreadToNumaNode... +Resume the RTS...Resumed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1762210f8b17de124dd2a20594eca75f97f4db9b...6e7134f59827bf197f310d24d33df74d6de6c0d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1762210f8b17de124dd2a20594eca75f97f4db9b...6e7134f59827bf197f310d24d33df74d6de6c0d9 You're receiving 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 22 22:05:50 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Tue, 22 Sep 2020 18:05:50 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] Return a Capability from rts_pause to allow use of other RtsAPI.h functions Message-ID: <5f6a753e35b2b_80b3f8402da5bb8138486f7@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: daddf2b1 by David Eichmann at 2020-09-22T23:05:36+01:00 Return a Capability from rts_pause to allow use of other RtsAPI.h functions - - - - - 9 changed files: - includes/RtsAPI.h - libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c - rts/RtsAPI.c - testsuite/tests/rts/ghc-debug/all.T - testsuite/tests/rts/ghc-debug/ghc_debug.c - testsuite/tests/rts/ghc-debug/ghc_debug.h - + testsuite/tests/rts/ghc-debug/ghc_debug_03.stdout - + testsuite/tests/rts/ghc-debug/ghc_debug_04.hs - + testsuite/tests/rts/ghc-debug/ghc_debug_04.stdout Changes: ===================================== includes/RtsAPI.h ===================================== @@ -335,11 +335,12 @@ extern void (*exitFn)(int); /* ---------------------------------------------------------------------------- Locking. - You have to surround all access to the RtsAPI with these calls. + You have to surround all access to the RtsAPI with rts_lock and rts_unlock + or with rts_pause and rts_resume. ------------------------------------------------------------------------- */ -// acquires a token which may be used to create new objects and -// evaluate them. +// acquires a token which may be used to create new objects and evaluate them. +// Calling rts_lock in between rts_pause/rts_resume will cause a deadlock. Capability *rts_lock (void); // releases the token acquired with rts_lock(). @@ -486,18 +487,22 @@ void rts_checkSchedStatus (char* site, Capability *); SchedulerStatus rts_getSchedStatus (Capability *cap); // Halt execution of all Haskell threads by acquiring all capabilities (safe FFI -// calls may continue). This is different to rts_lock() which only pauses a -// single capability. rts_resume() must later be called on the same thread to +// calls may continue). rts_resume() must later be called on the same thread to // resume the RTS. Only one thread at a time can keep the rts paused. The // rts_pause function will block until the current thread is given exclusive // permission to pause the RTS. If the RTS was already paused by the current OS -// thread, then rts_pause will return immediately and have no effect. -void rts_pause (void); +// thread, then rts_pause will return immediately and have no effect. Returns a +// token which may be used to create new objects and evaluate them (like +// rts_lock) .This is different to rts_lock() which only pauses a single +// capability. Calling rts_pause in between rts_lock/rts_unlock will cause a +// deadlock. +Capability * rts_pause (void); // Counterpart of rts_pause: Continue from a pause. All capabilities are // released. Must be done while RTS is paused and on the same thread as // rts_pause(). -void rts_resume (void); +// [in] cap: the token returned by rts_pause. +void rts_resume (Capability * cap); // Tells the current state of the RTS regarding rts_pause() and rts_resume(). bool rts_isPaused(void); ===================================== libraries/ghc-heap/tests/list_threads_and_misc_roots_c.c ===================================== @@ -23,10 +23,10 @@ void collectMiscRootsCallback(void *user, StgClosure* closure){ } void* listThreads_thread(void* unused){ - rts_pause(); + Capability * cap = rts_pause(); rts_listThreads(&collectTSOsCallback, NULL); rts_listMiscRoots(&collectMiscRootsCallback, NULL); - rts_resume(); + rts_resume(cap); return NULL; } ===================================== rts/RtsAPI.c ===================================== @@ -652,14 +652,14 @@ rts_unlock (Capability *cap) Task * rts_pausing_task = NULL; // See RtsAPI.h -void rts_pause (void) +Capability * rts_pause (void) { // Return immediately if this thread already paused the RTS. If another // thread has paused the RTS, then rts_pause will block until rts_resume is // called (and compete with other threads calling rts_pause). The blocking // behavior is implied by the use of `stopAllCapabilities`. Task * task = getMyTask(); - if (rts_pausing_task == task) return; + if (rts_pausing_task == task) return task->cap; // The current task must not own a capability. This is true when a new // thread is stareted, or when making a safe FFI call. If @@ -740,10 +740,13 @@ void rts_pause (void) // Now we own all capabilities so we own rts_pausing_task. rts_pausing_task = task; + + return task->cap; } -// See RtsAPI.h -void rts_resume (void) +// See RtsAPI.h The cap argument is here just for symmetry with rts_pause and to +// match the pattern of rts_lock/rts_unlock. +void rts_resume (Capability * cap STG_UNUSED) { Task * task = getMyTask(); // This thread has ownership over its Task. @@ -845,14 +848,14 @@ void rts_listMiscRoots (ListRootsCb cb, void *user) } #else -void rts_pause (void) +Capability * rts_pause (void) { errorBelch("Warning: Pausing the RTS is only possible for " "multithreaded RTS."); stg_exit(EXIT_FAILURE); } -void rts_resume (void) +void rts_resume (Capability * cap) { errorBelch("Warning: Unpausing the RTS is only possible for " "multithreaded RTS."); ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,18 +1,8 @@ -test('ghc_debug_01', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_01', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_02', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_02', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_03', - [ extra_files(['ghc_debug.c','ghc_debug.h']), - ignore_stdout, - ignore_stderr - ], +test('ghc_debug_03', [extra_files(['ghc_debug.c','ghc_debug.h'])], multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '-threaded ']) +test('ghc_debug_04', [extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], '-threaded ']) ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.c ===================================== @@ -1,3 +1,4 @@ +#include #include #include @@ -29,8 +30,17 @@ void pauseAndResume } // Pause and assert. - rts_pause(); - rts_pause(); // This should have no effect and return immediately. + Capability * cap = rts_pause(); + if(cap == NULL) { + errorBelch("rts_pause() returned NULL."); + exit(1); + } + Capability * cap2 = rts_pause(); // This should have no effect and return immediately. + if(cap != cap2) { + errorBelch("A second call to rts_pause() returned a different Capability."); + exit(1); + } + if(!rts_isPaused()) { errorBelch("Expected the RTS to be paused."); exit(1); @@ -39,7 +49,7 @@ void pauseAndResume expectNoChange("RTS should be paused", count); // Resume. - rts_resume(); + rts_resume(cap); // Assert the RTS is resumed. if (assertNotPaused) @@ -52,6 +62,125 @@ void pauseAndResume } } +int addOne(int a) +{ + return a + 1; +} + +// Pause tht RTS and call all RtsAPI.h functions. +void pauseAndUseRtsAPIAndResume + ( HaskellObj haskellFn // [in] A Haskell function (StablePtr (a -> a)) + , HaskellObj haskellFnArgument // [in] An argument to apply to haskellFn (a) + , HaskellObj obj1 // [in] arbitrary haskell value to evaluate of arbitrary type. + , HaskellObj obj2 // [in] arbitrary haskell value to evaluate of arbitrary type. + , HsStablePtr stablePtrIO // [in] arbitrary haskell IO action to execute (StablePtr (IO t)) + ) +{ + // Pause the RTS. + printf("Pause the RTS..."); + Capability * cap = rts_pause(); + printf("Paused\n"); + + // Note the original capability. We assert that cap is not changed by + // functions that take &cap. + Capability *const cap0 = cap; + + // Call RtsAPI.h functions + + // TODO print out what funciton is running to give better debug output if one of these deadlocks + + printf("getRTSStats...\n"); + RTSStats s; + getRTSStats (&s); + printf("getRTSStatsEnabled...\n"); + getRTSStatsEnabled(); + printf("getAllocations...\n"); + getAllocations(); + printf("rts_getSchedStatus...\n"); + rts_getSchedStatus(cap); + printf("rts_getChar, rts_mkChar...\n"); + rts_getChar (rts_mkChar ( cap, 0 )); + printf("rts_getInt, rts_mkInt...\n"); + rts_getInt (rts_mkInt ( cap, 0 )); + printf("rts_getInt8, rts_mkInt8...\n"); + rts_getInt8 (rts_mkInt8 ( cap, 0 )); + printf("rts_getInt16, rts_mkInt16...\n"); + rts_getInt16 (rts_mkInt16 ( cap, 0 )); + printf("rts_getInt32, rts_mkInt32...\n"); + rts_getInt32 (rts_mkInt32 ( cap, 0 )); + printf("rts_getInt64, rts_mkInt64...\n"); + rts_getInt64 (rts_mkInt64 ( cap, 0 )); + printf("rts_getWord, rts_mkWord...\n"); + rts_getWord (rts_mkWord ( cap, 0 )); + printf("rts_getWord8, rts_mkWord8...\n"); + rts_getWord8 (rts_mkWord8 ( cap, 0 )); + printf("rts_getWord16, rts_mkWord16...\n"); + rts_getWord16 (rts_mkWord16 ( cap, 0 )); + printf("rts_getWord32, rts_mkWord32...\n"); + rts_getWord32 (rts_mkWord32 ( cap, 0 )); + printf("rts_getWord64, rts_mkWord64...\n"); + rts_getWord64 (rts_mkWord64 ( cap, 0 )); + printf("rts_getPtr, rts_mkPtr...\n"); + int x = 0; + rts_getPtr (rts_mkPtr ( cap, &x)); + printf("rts_getFunPtr, rts_mkFunPtr...\n"); + rts_getFunPtr (rts_mkFunPtr ( cap, &addOne )); + printf("rts_getFloat, rts_mkFloat...\n"); + rts_getFloat (rts_mkFloat ( cap, 0.0 )); + printf("rts_getDouble, rts_mkDouble...\n"); + rts_getDouble (rts_mkDouble ( cap, 0.0 )); + printf("rts_getStablePtr, rts_mkStablePtr...\n"); + rts_getStablePtr (rts_mkStablePtr ( cap, &x )); + printf("rts_getBool, rts_mkBool...\n"); + rts_getBool (rts_mkBool ( cap, 0 )); + printf("rts_mkString...\n"); + rts_mkString ( cap, "Hello ghc-debug!" ); + printf("rts_apply...\n"); + rts_apply ( cap, deRefStablePtr(haskellFn), haskellFnArgument ); + + printf("rts_eval...\n"); + HaskellObj ret; + rts_eval(&cap, obj1, &ret); + assert(cap == cap0); + + printf("rts_eval_...\n"); + rts_eval_ (&cap, obj2, 50, &ret); + assert(cap == cap0); + + printf("rts_evalIO...\n"); + HaskellObj io = deRefStablePtr(stablePtrIO); + rts_evalIO (&cap, io, &ret); + assert(cap == cap0); + + printf("rts_evalStableIOMain...\n"); + HsStablePtr retStablePtr; + rts_evalStableIOMain (&cap, stablePtrIO, &retStablePtr); + assert(cap == cap0); + + printf("rts_evalStableIO...\n"); + rts_evalStableIO (&cap, stablePtrIO, &retStablePtr); + assert(cap == cap0); + + printf("rts_evalLazyIO...\n"); + rts_evalLazyIO (&cap, io, &ret); + assert(cap == cap0); + + printf("rts_evalLazyIO_...\n"); + rts_evalLazyIO_ (&cap, io, 50, &ret); + assert(cap == cap0); + + printf("rts_setInCallCapability...\n"); + rts_setInCallCapability (0, 1); + printf("rts_pinThreadToNumaNode...\n"); + rts_pinThreadToNumaNode (0); + + // Resume the RTS. + printf("Resume the RTS..."); + rts_resume(cap); + assert(cap == cap0); + printf("Resumed\n"); +} + void* pauseAndResumeViaThread_helper(volatile unsigned int * count) { pauseAndResume(false, count); ===================================== testsuite/tests/rts/ghc-debug/ghc_debug.h ===================================== @@ -1,3 +1,10 @@ void pauseAndResume(bool assertNotPaused, volatile unsigned int * count); unsigned long pauseAndResumeViaThread(volatile unsigned int * count); +void pauseAndUseRtsAPIAndResume + ( HaskellObj haskellFn + , HaskellObj haskellFnArgument + , HaskellObj obj1 + , HaskellObj obj2 + , HsStablePtr stablePtrIO + ); ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_03.stdout ===================================== @@ -0,0 +1 @@ +All threads finished ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_04.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Foreign +import System.Exit +import System.Timeout + +foreign import ccall safe "ghc_debug.h pauseAndUseRtsAPIAndResume" + pauseAndUseRtsAPIAndResume + :: (StablePtr (Int -> Int)) + -> Int + -> Int + -> Int + -> (StablePtr (IO Int)) + -> IO () + +main :: IO () +main = do + addOne <- newStablePtr ((+1) :: Int -> Int) + ioOne <- newStablePtr (return 1 :: IO Int) + successMay <- timeout 5000000 $ pauseAndUseRtsAPIAndResume + addOne + 1 + 2 + 3 + ioOne + case successMay of + Nothing -> exitFailure + Just () -> exitSuccess ===================================== testsuite/tests/rts/ghc-debug/ghc_debug_04.stdout ===================================== @@ -0,0 +1,34 @@ +Pause the RTS...Paused +getRTSStats... +getRTSStatsEnabled... +getAllocations... +rts_getSchedStatus... +rts_getChar, rts_mkChar... +rts_getInt, rts_mkInt... +rts_getInt8, rts_mkInt8... +rts_getInt16, rts_mkInt16... +rts_getInt32, rts_mkInt32... +rts_getInt64, rts_mkInt64... +rts_getWord, rts_mkWord... +rts_getWord8, rts_mkWord8... +rts_getWord16, rts_mkWord16... +rts_getWord32, rts_mkWord32... +rts_getWord64, rts_mkWord64... +rts_getPtr, rts_mkPtr... +rts_getFunPtr, rts_mkFunPtr... +rts_getFloat, rts_mkFloat... +rts_getDouble, rts_mkDouble... +rts_getStablePtr, rts_mkStablePtr... +rts_getBool, rts_mkBool... +rts_mkString... +rts_apply... +rts_eval... +rts_eval_... +rts_evalIO... +rts_evalStableIOMain... +rts_evalStableIO... +rts_evalLazyIO... +rts_evalLazyIO_... +rts_setInCallCapability... +rts_pinThreadToNumaNode... +Resume the RTS...Resumed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/daddf2b184bc79fd51823aae83a790acf76020d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/daddf2b184bc79fd51823aae83a790acf76020d5 You're receiving 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 22 22:10:21 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 22 Sep 2020 18:10:21 -0400 Subject: [Git][ghc/ghc][wip/T18126] 46 commits: Make Z-encoding comment into a note Message-ID: <5f6a764da7f1_80b3f849bf71f48138498f4@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 9632f413 by Simon Peyton Jones at 2020-09-22T22:51:53+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - cca982e8 by Simon Peyton Jones at 2020-09-22T22:51:53+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 - - - - - 30 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfa0996647bdaf55228659b00125220a76ba0d4c...cca982e8fc2ab6e99c6e21b4db56f938f5e5c55d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfa0996647bdaf55228659b00125220a76ba0d4c...cca982e8fc2ab6e99c6e21b4db56f938f5e5c55d You're receiving 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 22 22:45:31 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 22 Sep 2020 18:45:31 -0400 Subject: [Git][ghc/ghc][wip/T16762] 63 commits: Include -f{write,validate}-ide-info in the User's Guide flag reference Message-ID: <5f6a7e8b962b9_80b3f84119ce788138650d9@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 9632f413 by Simon Peyton Jones at 2020-09-22T22:51:53+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - cca982e8 by Simon Peyton Jones at 2020-09-22T22:51:53+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 - - - - - f80e9cf7 by Ryan Scott at 2020-09-22T23:28:04+01:00 WIP: T16762 [ci skip] - - - - - bddc98e1 by Simon Peyton Jones at 2020-09-22T23:28:04+01:00 Wibbbles - - - - - b7d4acc9 by Simon Peyton Jones at 2020-09-22T23:28:04+01:00 More wibbles - - - - - 771121c8 by Simon Peyton Jones at 2020-09-22T23:44:53+01:00 More wibbles - - - - - 30 changed files: - .gitlab/ci.sh - README.md - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef6dfbaacffbaddc0a20a28fb00141f327f63761...771121c88e0afeea1993a1fec5ea99bdfcd3f555 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef6dfbaacffbaddc0a20a28fb00141f327f63761...771121c88e0afeea1993a1fec5ea99bdfcd3f555 You're receiving 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 23 08:04:30 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 04:04:30 -0400 Subject: [Git][ghc/ghc][wip/T18708] Update T18708.hs Message-ID: <5f6b018ea5947_80b3f8475fc535813886443@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18708 at Glasgow Haskell Compiler / GHC Commits: 5c60f250 by Sebastian Graf at 2020-09-23T04:04:29-04:00 Update T18708.hs - - - - - 1 changed file: - testsuite/tests/pmcheck/should_compile/T18708.hs Changes: ===================================== testsuite/tests/pmcheck/should_compile/T18708.hs ===================================== @@ -17,4 +17,5 @@ main :: IO () main = do case y of "y" -> return () - return () \ No newline at end of file + return () + \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c60f250fb1db35b1f3d015b4ea7a6e3b0c7d8cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c60f250fb1db35b1f3d015b4ea7a6e3b0c7d8cd You're receiving 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 23 08:04:42 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 04:04:42 -0400 Subject: [Git][ghc/ghc][wip/T18708] Update T18708.hs Message-ID: <5f6b019a27fb2_80b3f8475fc53581388687@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18708 at Glasgow Haskell Compiler / GHC Commits: 3926ac2b by Sebastian Graf at 2020-09-23T04:04:40-04:00 Update T18708.hs - - - - - 1 changed file: - testsuite/tests/pmcheck/should_compile/T18708.hs Changes: ===================================== testsuite/tests/pmcheck/should_compile/T18708.hs ===================================== @@ -18,4 +18,3 @@ main = do case y of "y" -> return () return () - \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3926ac2bc11938163ee1222b0f754e5dd356b6a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3926ac2bc11938163ee1222b0f754e5dd356b6a4 You're receiving 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 23 08:06:17 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 04:06:17 -0400 Subject: [Git][ghc/ghc][wip/T18708] PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Message-ID: <5f6b01f9613f_80b10dd25601388727b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18708 at Glasgow Haskell Compiler / GHC Commits: 075ce0af by Sebastian Graf at 2020-09-23T10:06:10+02:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 4 changed files: - compiler/GHC/HsToCore/PmCheck/Types.hs - + testsuite/tests/pmcheck/should_compile/T18708.hs - + testsuite/tests/pmcheck/should_compile/T18708.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -349,16 +349,17 @@ coreExprAsPmLit e = case collectArgs e of -- Take care of -XRebindableSyntax. The last argument should be the (only) -- integer literal, otherwise we can't really do much about it. | [Lit l] <- dropWhile (not . is_lit) args - -- getOccFS because of -XRebindableSyntax - , getOccFS (idName x) == getOccFS fromIntegerName + , is_rebound_name x fromIntegerName -> literalToPmLit (literalType l) l >>= overloadPmLit (exprType e) (Var x, args) -- Similar to fromInteger case | [r] <- dropWhile (not . is_ratio) args - , getOccFS (idName x) == getOccFS fromRationalName + , is_rebound_name x fromRationalName -> coreExprAsPmLit r >>= overloadPmLit (exprType e) - (Var x, [Type _ty, _dict, s]) - | idName x == fromStringName + (Var x, args) + | is_rebound_name x fromStringName + -- With -XRebindableSyntax or without: The first String argument is what we are after + , s:_ <- filter (eqType stringTy . exprType) args -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings -> coreExprAsPmLit s >>= overloadPmLit (exprType e) -- These last two cases handle String literals @@ -381,6 +382,11 @@ coreExprAsPmLit e = case collectArgs e of | otherwise = False + -- | Compares the given Id to the Name based on OccName, to detect + -- -XRebindableSyntax. + is_rebound_name :: Id -> Name -> Bool + is_rebound_name x n = getOccFS (idName x) == getOccFS n + instance Outputable PmLitValue where ppr (PmLitInt i) = ppr i ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough ===================================== testsuite/tests/pmcheck/should_compile/T18708.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} + +module A (main) where + +import Prelude +import Data.Text + + +fromString :: String -> Text +fromString = pack + +y :: Text +y = "y" + +main :: IO () +main = do + case y of + "y" -> return () + return () ===================================== testsuite/tests/pmcheck/should_compile/T18708.stderr ===================================== @@ -0,0 +1,5 @@ + +T18708.hs:18:3: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: + Patterns not matched: p where p is not one of {"y"} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -146,6 +146,8 @@ test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18708', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/075ce0af6e59493d7efa2502630e40b11ca887c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/075ce0af6e59493d7efa2502630e40b11ca887c1 You're receiving 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 23 10:52:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 06:52:16 -0400 Subject: [Git][ghc/ghc][master] Remove the list of loaded modules from the ghci prompt Message-ID: <5f6b28e05056a_80b3f845036c92813904889@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - 2 changed files: - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs Changes: ===================================== docs/users_guide/ghci.rst ===================================== @@ -40,7 +40,7 @@ command ``ghci``: $ ghci GHCi, version 8.y.z: https://www.haskell.org/ghc/ :? for help - Prelude> + ghci> There may be a short pause while GHCi loads the prelude and standard libraries, after which the prompt is shown. As the banner says, you can @@ -56,11 +56,11 @@ Haskell expressions can be typed at the prompt: .. code-block:: none - Prelude> 1+2 + ghci> 1+2 3 - Prelude> let x = 42 in x / 9 + ghci> let x = 42 in x / 9 4.666666666666667 - Prelude> + ghci> GHCi interprets the whole line as an expression to evaluate. The expression may not span several lines - as soon as you press enter, GHCi @@ -75,10 +75,10 @@ Since GHC 8.0.1, you can bind values and functions to names without ``let`` stat .. code-block:: none - Prelude> x = 42 - Prelude> x + ghci> x = 42 + ghci> x 42 - Prelude> + ghci> .. _loading-source-files: @@ -99,7 +99,7 @@ right directory in GHCi: .. code-block:: none - Prelude> :cd dir + ghci> :cd dir where ⟨dir⟩ is the directory (or folder) in which you saved ``Main.hs``. @@ -110,20 +110,20 @@ To load a Haskell source file into GHCi, use the :ghci-cmd:`:load` command: .. code-block:: none - Prelude> :load Main + ghci> :load Main Compiling Main ( Main.hs, interpreted ) Ok, modules loaded: Main. - *Main> + *ghci> GHCi has loaded the ``Main`` module, and the prompt has changed to -``*Main>`` to indicate that the current context for expressions +``*ghci>`` to indicate that the current context for expressions typed at the prompt is the ``Main`` module we just loaded (we'll explain what the ``*`` means later in :ref:`ghci-scope`). So we can now type expressions involving the functions from ``Main.hs``: .. code-block:: none - *Main> fac 17 + *ghci> fac 17 355687428096000 Loading a multi-module program is just as straightforward; just give the @@ -251,13 +251,13 @@ We can compile ``D``, then load the whole program, like this: .. code-block:: none - Prelude> :! ghc -c -dynamic D.hs - Prelude> :load A + ghci> :! ghc -c -dynamic D.hs + ghci> :load A Compiling B ( B.hs, interpreted ) Compiling C ( C.hs, interpreted ) Compiling A ( A.hs, interpreted ) Ok, modules loaded: A, B, C, D (D.o). - *Main> + *ghci> In the messages from the compiler, we see that there is no line for ``D``. This is because it isn't necessary to compile ``D``, because the @@ -273,12 +273,12 @@ the modules currently loaded into GHCi: .. code-block:: none - *Main> :show modules + *ghci> :show modules D ( D.hs, D.o ) C ( C.hs, interpreted ) B ( B.hs, interpreted ) A ( A.hs, interpreted ) - *Main> + *ghci> If we now modify the source of ``D`` (or pretend to: using the Unix command ``touch`` on the source file is handy for this), the compiler will no @@ -286,11 +286,11 @@ longer be able to use the object file, because it might be out of date: .. code-block:: none - *Main> :! touch D.hs - *Main> :reload + *ghci> :! touch D.hs + *ghci> :reload Compiling D ( D.hs, interpreted ) Ok, modules loaded: A, B, C, D. - *Main> + *ghci> Note that module ``D`` was compiled, but in this instance because its source hadn't really changed, its interface remained the same, and the @@ -301,8 +301,8 @@ So let's try compiling one of the other modules: .. code-block:: none - *Main> :! ghc -c C.hs - *Main> :load A + *ghci> :! ghc -c C.hs + *ghci> :load A Compiling D ( D.hs, interpreted ) Compiling B ( B.hs, interpreted ) Compiling C ( C.hs, interpreted ) @@ -316,8 +316,8 @@ rejected ``C``\'s object file. Ok, so let's also compile ``D``: .. code-block:: none - *Main> :! ghc -c D.hs - *Main> :reload + *ghci> :! ghc -c D.hs + *ghci> :reload Ok, modules loaded: A, B, C, D. Nothing happened! Here's another lesson: newly compiled modules aren't @@ -325,7 +325,7 @@ picked up by :ghci-cmd:`:reload`, only :ghci-cmd:`:load`: .. code-block:: none - *Main> :load A + *ghci> :load A Compiling B ( B.hs, interpreted ) Compiling A ( A.hs, interpreted ) Ok, modules loaded: A, B, C (C.o), D (D.o). @@ -340,9 +340,9 @@ when using :ghci-cmd:`:load`, for example .. code-block:: none - Prelude> :load *A + ghci> :load *A Compiling A ( A.hs, interpreted ) - *A> + *ghci> When the ``*`` is used, GHCi ignores any pre-compiled object code and interprets the module. If you have already loaded a number of modules as @@ -373,9 +373,9 @@ and prints the result: .. code-block:: none - Prelude> reverse "hello" + ghci> reverse "hello" "olleh" - Prelude> 5+5 + ghci> 5+5 10 .. _actions-at-prompt: @@ -389,9 +389,9 @@ enter an expression of type ``IO a`` for some ``a``, then GHCi .. code-block:: none - Prelude> "hello" + ghci> "hello" "hello" - Prelude> putStrLn "hello" + ghci> putStrLn "hello" hello This works even if the type of the expression is more general, provided @@ -399,7 +399,7 @@ it can be *instantiated* to ``IO a``. For example .. code-block:: none - Prelude> return True + ghci> return True True Furthermore, GHCi will print the result of the I/O action if (and only @@ -413,9 +413,9 @@ For example, remembering that ``putStrLn :: String -> IO ()``: .. code-block:: none - Prelude> putStrLn "hello" + ghci> putStrLn "hello" hello - Prelude> do { putStrLn "hello"; return "yes" } + ghci> do { putStrLn "hello"; return "yes" } hello "yes" @@ -439,10 +439,10 @@ prompt must be in the ``IO`` monad. .. code-block:: none - Prelude> x <- return 42 - Prelude> print x + ghci> x <- return 42 + ghci> print x 42 - Prelude> + ghci> The statement ``x <- return 42`` means “execute ``return 42`` in the ``IO`` monad, and bind the result to ``x``\ ”. We can then use ``x`` in @@ -468,10 +468,10 @@ Of course, you can also bind normal non-IO expressions using the .. code-block:: none - Prelude> let x = 42 - Prelude> x + ghci> let x = 42 + ghci> x 42 - Prelude> + ghci> Another important difference between the two types of binding is that the monadic bind (``p <- e``) is *strict* (it evaluates ``e``), whereas @@ -479,10 +479,10 @@ with the ``let`` form, the expression isn't evaluated immediately: .. code-block:: none - Prelude> let x = error "help!" - Prelude> print x + ghci> let x = error "help!" + ghci> print x *** Exception: help! - Prelude> + ghci> Note that ``let`` bindings do not automatically print the value bound, unlike monadic bindings. @@ -491,10 +491,10 @@ You can also define functions at the prompt: .. code-block:: none - Prelude> add a b = a + b - Prelude> add 1 2 + ghci> add a b = a + b + ghci> add 1 2 3 - Prelude> + ghci> However, this quickly gets tedious when defining functions with multiple clauses, or groups of mutually recursive functions, because the complete @@ -503,10 +503,10 @@ instead of layout: .. code-block:: none - Prelude> f op n [] = n ; f op n (h:t) = h `op` f op n t - Prelude> f (+) 0 [1..3] + ghci> f op n [] = n ; f op n (h:t) = h `op` f op n t + ghci> f (+) 0 [1..3] 6 - Prelude> + ghci> .. ghci-cmd:: :{ :} @@ -519,11 +519,11 @@ own): .. code-block:: none - Prelude> :{ - Prelude| g op n [] = n - Prelude| g op n (h:t) = h `op` g op n t - Prelude| :} - Prelude> g (*) 1 [1..3] + ghci> :{ + | g op n [] = n + | g op n (h:t) = h `op` g op n t + | :} + ghci> g (*) 1 [1..3] 6 Such multiline commands can be used with any GHCi command, and note that @@ -551,9 +551,9 @@ including entities that are in scope in the current module context. .. code-block:: none - Prelude> :show bindings + ghci> :show bindings x :: Int - Prelude> + ghci> .. hint:: If you turn on the ``+t`` option, GHCi will show the type of each @@ -561,8 +561,8 @@ including entities that are in scope in the current module context. .. code-block:: none - Prelude> :set +t - Prelude> let (x:xs) = [1..] + ghci> :set +t + ghci> let (x:xs) = [1..] x :: Integer xs :: [Integer] @@ -583,9 +583,9 @@ multi-line input is terminated with an empty line. For example: .. code-block:: none - Prelude> :set +m - Prelude> let x = 42 - Prelude| + ghci> :set +m + ghci> let x = 42 + | Further bindings can be added to this ``let`` statement, so GHCi indicates that the next line continues the previous one by changing the @@ -594,23 +594,23 @@ prompt. Note that layout is in effect, so to add more bindings to this .. code-block:: none - Prelude> :set +m - Prelude> let x = 42 - Prelude| y = 3 - Prelude| - Prelude> + ghci> :set +m + ghci> let x = 42 + | y = 3 + | + ghci> Explicit braces and semicolons can be used instead of layout: .. code-block:: none - Prelude> do { - Prelude| putStrLn "hello" - Prelude| ;putStrLn "world" - Prelude| } + ghci> do { + | putStrLn "hello" + | ;putStrLn "world" + | } hello world - Prelude> + ghci> Note that after the closing brace, GHCi knows that the current statement is finished, so no empty line is required. @@ -619,25 +619,25 @@ Multiline mode is useful when entering monadic ``do`` statements: .. code-block:: none - Control.Monad.State> flip evalStateT 0 $ do - Control.Monad.State| i <- get - Control.Monad.State| lift $ do - Control.Monad.State| putStrLn "Hello World!" - Control.Monad.State| print i - Control.Monad.State| + ghci> flip evalStateT 0 $ do + | i <- get + | lift $ do + | putStrLn "Hello World!" + | print i + | "Hello World!" 0 - Control.Monad.State> + ghci> During a multiline interaction, the user can interrupt and return to the top-level prompt. .. code-block:: none - Prelude> do - Prelude| putStrLn "Hello, World!" - Prelude| ^C - Prelude> + ghci> do + | putStrLn "Hello, World!" + | ^C + ghci> .. _ghci-decls: @@ -650,10 +650,10 @@ including ``data``, ``type``, ``newtype``, ``class``, ``instance``, .. code-block:: none - Prelude> data T = A | B | C deriving (Eq, Ord, Show, Enum) - Prelude> [A ..] + ghci> data T = A | B | C deriving (Eq, Ord, Show, Enum) + ghci> [A ..] [A,B,C] - Prelude> :i T + ghci> :i T data T = A | B | C -- Defined at :2:6 instance Enum T -- Defined at :2:45 instance Eq T -- Defined at :2:30 @@ -671,10 +671,10 @@ example: .. code-block:: none - Prelude> data T = A | B - Prelude> let f A = True; f B = False - Prelude> data T = A | B | C - Prelude> f A + ghci> data T = A | B + ghci> let f A = True; f B = False + ghci> data T = A | B | C + ghci> f A :2:3: Couldn't match expected type `main::Interactive.T' @@ -682,7 +682,7 @@ example: In the first argument of `f', namely `A' In the expression: f A In an equation for `it': it = f A - Prelude> + ghci> The old, shadowed, version of ``T`` is displayed as ``main::Interactive.T`` by GHCi in an attempt to distinguish it from the @@ -697,11 +697,11 @@ the whole type-family. (See :ref:`type-families`.) For example: .. code-block:: none - Prelude> type family T a b - Prelude> type instance T a b = a - Prelude> let uc :: a -> T a b; uc = id + ghci> type family T a b + ghci> type instance T a b = a + ghci> let uc :: a -> T a b; uc = id - Prelude> type instance T a b = b + ghci> type instance T a b = b :3:15: error: Conflicting family instance declarations: @@ -710,10 +710,10 @@ the whole type-family. (See :ref:`type-families`.) For example: -- Darn! We have to re-declare T. - Prelude> type family T a b + ghci> type family T a b -- This is a brand-new T, unrelated to the old one - Prelude> type instance T a b = b - Prelude> uc 'a' :: Int + ghci> type instance T a b = b + ghci> uc 'a' :: Int :8:1: error: • Couldn't match type ‘Char’ with ‘Int’ @@ -758,25 +758,12 @@ the prompt looks like this: .. code-block:: none - Prelude> + ghci> -which indicates that everything from the module ``Prelude`` is currently -in scope; the visible identifiers are exactly those that would be -visible in a Haskell source file with no ``import`` declarations. - -If we now load a file into GHCi, the prompt will change: - -.. code-block:: none - - Prelude> :load Main.hs - Compiling Main ( Main.hs, interpreted ) - *Main> - -The new prompt is ``*Main``, which indicates that we are typing -expressions in the context of the top-level of the ``Main`` module. -Everything that is in scope at the top-level in the module ``Main`` we -just loaded is also in scope at the prompt (probably including -``Prelude``, as long as ``Main`` doesn't explicitly hide it). +By default, this means that everything from the module ``Prelude`` is currently +in scope. Should the prompt be set to ``%s>`` in the ``.ghci`` configuration +file, we would be seeing ``Prelude>`` displayed. However, it is not the default +mechanism due to the large space the prompt can take if more imports are done. The syntax in the prompt ``*module`` indicates that it is the full top-level scope of ⟨module⟩ that is contributing to the scope for @@ -795,18 +782,18 @@ the scope for the most recently loaded "target" module, in a ``*``-form if possible. For example, if you say ``:load foo.hs bar.hs`` and ``bar.hs`` contains module ``Bar``, then the scope will be set to ``*Bar`` if ``Bar`` is interpreted, or if ``Bar`` is compiled it will be -set to ``Prelude Bar`` (GHCi automatically adds ``Prelude`` if it isn't +set to ``Prelude`` and ``Bar`` (GHCi automatically adds ``Prelude`` if it isn't present and there aren't any ``*``-form modules). These automatically-added imports can be seen with :ghci-cmd:`:show imports`: .. code-block:: none - Prelude> :load hello.hs + ghci> :load hello.hs [1 of 1] Compiling Main ( hello.hs, interpreted ) Ok, modules loaded: Main. - *Main> :show imports + *ghci> :show imports :module +*Main -- added automatically - *Main> + *ghci> and the automatically-added import is replaced the next time you use :ghci-cmd:`:load`, :ghci-cmd:`:add`, or :ghci-cmd:`:reload`. It can also be @@ -826,10 +813,9 @@ To add modules to the scope, use ordinary Haskell ``import`` syntax: .. code-block:: none - Prelude> import System.IO - Prelude System.IO> hPutStrLn stdout "hello\n" + ghci> import System.IO + ghci> hPutStrLn stdout "hello\n" hello - Prelude System.IO> The full Haskell import syntax is supported, including ``hiding`` and ``as`` clauses. The prompt shows the modules that are currently @@ -838,13 +824,12 @@ see the full story, use :ghci-cmd:`:show imports`: .. code-block:: none - Prelude> import System.IO - Prelude System.IO> import Data.Map as Map - Prelude System.IO Map> :show imports + ghci> import System.IO + ghci> import Data.Map as Map + ghci Map> :show imports import Prelude -- implicit import System.IO import Data.Map as Map - Prelude System.IO Map> Note that the ``Prelude`` import is marked as implicit. It can be overridden with an explicit ``Prelude`` import, just like in a Haskell @@ -934,8 +919,8 @@ arguments, e.g.: .. code-block:: none - Prelude> main = System.Environment.getArgs >>= print - Prelude> :main foo bar + ghci> main = System.Environment.getArgs >>= print + ghci> :main foo bar ["foo","bar"] We can also quote arguments which contains characters like spaces, and @@ -944,9 +929,9 @@ syntax: .. code-block:: none - Prelude> :main foo "bar baz" + ghci> :main foo "bar baz" ["foo","bar baz"] - Prelude> :main ["foo", "bar baz"] + ghci> :main ["foo", "bar baz"] ["foo","bar baz"] Finally, other functions can be called, either with the ``-main-is`` @@ -954,13 +939,13 @@ flag or the :ghci-cmd:`:run` command: .. code-block:: none - Prelude> foo = putStrLn "foo" >> System.Environment.getArgs >>= print - Prelude> bar = putStrLn "bar" >> System.Environment.getArgs >>= print - Prelude> :set -main-is foo - Prelude> :main foo "bar baz" + ghci> foo = putStrLn "foo" >> System.Environment.getArgs >>= print + ghci> bar = putStrLn "bar" >> System.Environment.getArgs >>= print + ghci> :set -main-is foo + ghci> :main foo "bar baz" foo ["foo","bar baz"] - Prelude> :run bar ["foo", "bar baz"] + ghci> :run bar ["foo", "bar baz"] bar ["foo","bar baz"] @@ -976,9 +961,9 @@ typed at the prompt, GHCi implicitly binds its value to the variable .. code-block:: none - Prelude> 1+2 + ghci> 1+2 3 - Prelude> it * 2 + ghci> it * 2 6 What actually happens is that GHCi typechecks the expression, and if it @@ -997,7 +982,7 @@ the ``Show`` class, or GHCi will complain: .. code-block:: none - Prelude> id + ghci> id :1:0: No instance for (Show (a -> a)) @@ -1015,9 +1000,9 @@ of type ``a``. eg.: .. code-block:: none - Prelude> Data.Time.getZonedTime + ghci> Data.Time.getZonedTime 2017-04-10 12:34:56.93213581 UTC - Prelude> print it + ghci> print it 2017-04-10 12:34:56.93213581 UTC The corresponding translation for an IO-typed ``e`` is @@ -1342,19 +1327,19 @@ First, load the module into GHCi: .. code-block:: none - Prelude> :l qsort.hs + ghci> :l qsort.hs [1 of 1] Compiling Main ( qsort.hs, interpreted ) Ok, modules loaded: Main. - *Main> + *ghci> Now, let's set a breakpoint on the right-hand-side of the second equation of qsort: .. code-block:: none - *Main> :break 2 + *ghci> :break 2 Breakpoint 0 activated at qsort.hs:2:15-46 - *Main> + *ghci> The command ``:break 2`` sets a breakpoint on line 2 of the most recently-loaded module, in this case ``qsort.hs``. Specifically, it @@ -1366,13 +1351,13 @@ Now, we run the program: .. code-block:: none - *Main> main + *ghci> main Stopped at qsort.hs:2:15-46 _result :: [a] a :: a left :: [a] right :: [a] - [qsort.hs:2:15-46] *Main> + [qsort.hs:2:15-46] *ghci> Execution has stopped at the breakpoint. The prompt has changed to indicate that we are currently stopped at a breakpoint, and the @@ -1381,7 +1366,7 @@ can use the :ghci-cmd:`:list` command: .. code-block:: none - [qsort.hs:2:15-46] *Main> :list + [qsort.hs:2:15-46] *ghci> :list 1 qsort [] = [] 2 qsort (a:as) = qsort left ++ [a] ++ qsort right 3 where (left,right) = (filter (<=a) as, filter (>a) as) @@ -1401,7 +1386,7 @@ types. For example, if we try to display the value of ``left``: .. code-block:: none - [qsort.hs:2:15-46] *Main> left + [qsort.hs:2:15-46] *ghci> left :1:0: Ambiguous type variable `a' in the constraint: @@ -1421,8 +1406,8 @@ attempt to reconstruct its type. If we try it on ``left``: .. code-block:: none - [qsort.hs:2:15-46] *Main> :set -fprint-evld-with-show - [qsort.hs:2:15-46] *Main> :print left + [qsort.hs:2:15-46] *ghci> :set -fprint-evld-with-show + [qsort.hs:2:15-46] *ghci> :print left left = (_t1::[a]) This isn't particularly enlightening. What happened is that ``left`` is @@ -1452,7 +1437,7 @@ evaluation of any thunks it encounters: .. code-block:: none - [qsort.hs:2:15-46] *Main> :force left + [qsort.hs:2:15-46] *ghci> :force left left = [4,0,3,1] Now, since :ghci-cmd:`:force` has inspected the runtime value of ``left``, it @@ -1461,7 +1446,7 @@ reconstruction: .. code-block:: none - [qsort.hs:2:15-46] *Main> :show bindings + [qsort.hs:2:15-46] *ghci> :show bindings _result :: [Integer] a :: Integer left :: [Integer] @@ -1474,7 +1459,7 @@ example: .. code-block:: none - [qsort.hs:2:15-46] *Main> a + [qsort.hs:2:15-46] *ghci> a 8 You might find it useful to use Haskell's ``seq`` function to evaluate @@ -1483,11 +1468,11 @@ individual thunks rather than evaluating the whole expression with .. code-block:: none - [qsort.hs:2:15-46] *Main> :print right + [qsort.hs:2:15-46] *ghci> :print right right = (_t1::[Integer]) - [qsort.hs:2:15-46] *Main> seq _t1 () + [qsort.hs:2:15-46] *ghci> seq _t1 () () - [qsort.hs:2:15-46] *Main> :print right + [qsort.hs:2:15-46] *ghci> :print right right = 23 : (_t2::[Integer]) We evaluated only the ``_t1`` thunk, revealing the head of the list, and @@ -1499,13 +1484,13 @@ Finally, we can continue the current execution: .. code-block:: none - [qsort.hs:2:15-46] *Main> :continue + [qsort.hs:2:15-46] *ghci> :continue Stopped at qsort.hs:2:15-46 _result :: [a] a :: a left :: [a] right :: [a] - [qsort.hs:2:15-46] *Main> + [qsort.hs:2:15-46] *ghci> The execution continued at the point it previously stopped, and has now stopped at the breakpoint for a second time. @@ -1611,7 +1596,7 @@ The list of breakpoints currently defined can be displayed using .. code-block:: none - *Main> :show breaks + *ghci> :show breaks [0] Main qsort.hs:1:11-12 enabled [1] Main qsort.hs:2:15-46 enabled @@ -1622,8 +1607,8 @@ To disable all breakpoints at once, use ``:disable *``. .. code-block:: none - *Main> :disable 0 - *Main> :show breaks + *ghci> :disable 0 + *ghci> :show breaks [0] Main qsort.hs:1:11-12 disabled [1] Main qsort.hs:2:15-46 enabled @@ -1635,8 +1620,8 @@ given in the output from :ghci-cmd:`:show breaks`: .. code-block:: none - *Main> :delete 0 - *Main> :show breaks + *ghci> :delete 0 + *ghci> :show breaks [1] Main qsort.hs:2:15-46 disabled To delete all breakpoints at once, use ``:delete *``. @@ -1657,7 +1642,7 @@ example: .. code-block:: none - *Main> :step main + *ghci> :step main Stopped at qsort.hs:5:7-47 _result :: IO () @@ -1671,25 +1656,25 @@ see where you currently are: .. code-block:: none - [qsort.hs:5:7-47] *Main> :list + [qsort.hs:5:7-47] *ghci> :list 4 5 main = print (qsort [8, 4, 0, 3, 1, 23, 11, 18]) 6 - [qsort.hs:5:7-47] *Main> + [qsort.hs:5:7-47] *ghci> In fact, GHCi provides a way to run a command when a breakpoint is hit, so we can make it automatically do :ghci-cmd:`:list`: .. code-block:: none - [qsort.hs:5:7-47] *Main> :set stop :list - [qsort.hs:5:7-47] *Main> :step + [qsort.hs:5:7-47] *ghci> :set stop :list + [qsort.hs:5:7-47] *ghci> :step Stopped at qsort.hs:5:14-46 _result :: [Integer] 4 5 main = print (qsort [8, 4, 0, 3, 1, 23, 11, 18]) 6 - [qsort.hs:5:14-46] *Main> + [qsort.hs:5:14-46] *ghci> .. _nested-breakpoints: @@ -1703,10 +1688,10 @@ of breakpoint contexts can be built up in this way. For example: .. code-block:: none - [qsort.hs:2:15-46] *Main> :st qsort [1,3] + [qsort.hs:2:15-46] *ghci> :st qsort [1,3] Stopped at qsort.hs:(1,0)-(3,55) _result :: [a] - ... [qsort.hs:(1,0)-(3,55)] *Main> + ... [qsort.hs:(1,0)-(3,55)] *ghci> While stopped at the breakpoint on line 2 that we set earlier, we started a new evaluation with ``:step qsort [1,3]``. This new evaluation @@ -1717,20 +1702,20 @@ breakpoints beyond the current one. To see the stack of contexts, use .. code-block:: none - ... [qsort.hs:(1,0)-(3,55)] *Main> :show context + ... [qsort.hs:(1,0)-(3,55)] *ghci> :show context --> main Stopped at qsort.hs:2:15-46 --> qsort [1,3] Stopped at qsort.hs:(1,0)-(3,55) - ... [qsort.hs:(1,0)-(3,55)] *Main> + ... [qsort.hs:(1,0)-(3,55)] *ghci> To abandon the current evaluation, use :ghci-cmd:`:abandon`: .. code-block:: none - ... [qsort.hs:(1,0)-(3,55)] *Main> :abandon - [qsort.hs:2:15-46] *Main> :abandon - *Main> + ... [qsort.hs:(1,0)-(3,55)] *ghci> :abandon + [qsort.hs:2:15-46] *ghci> :abandon + *ghci> .. _ghci-debugger-result: @@ -1777,29 +1762,29 @@ example, if we set a breakpoint on the base case of ``qsort``: .. code-block:: none - *Main> :list qsort + *ghci> :list qsort 1 qsort [] = [] 2 qsort (a:as) = qsort left ++ [a] ++ qsort right 3 where (left,right) = (filter (<=a) as, filter (>a) as) 4 - *Main> :b 1 + *ghci> :b 1 Breakpoint 1 activated at qsort.hs:1:11-12 - *Main> + *ghci> and then run a small ``qsort`` with tracing: .. code-block:: none - *Main> :trace qsort [3,2,1] + *ghci> :trace qsort [3,2,1] Stopped at qsort.hs:1:11-12 _result :: [a] - [qsort.hs:1:11-12] *Main> + [qsort.hs:1:11-12] *ghci> We can now inspect the history of evaluation steps: .. code-block:: none - [qsort.hs:1:11-12] *Main> :hist + [qsort.hs:1:11-12] *ghci> :hist -1 : qsort.hs:3:24-38 -2 : qsort.hs:3:23-55 -3 : qsort.hs:(1,0)-(3,55) @@ -1822,12 +1807,12 @@ To examine one of the steps in the history, use :ghci-cmd:`:back`: .. code-block:: none - [qsort.hs:1:11-12] *Main> :back + [qsort.hs:1:11-12] *ghci> :back Logged breakpoint at qsort.hs:3:24-38 _result :: [a] as :: [a] a :: a - [-1: qsort.hs:3:24-38] *Main> + [-1: qsort.hs:3:24-38] *ghci> Note that the local variables at each step in the history have been preserved, and can be examined as usual. Also note that the prompt has @@ -1883,11 +1868,11 @@ example: .. code-block:: none - *Main> :set -fbreak-on-exception - *Main> :trace qsort ("abc" ++ undefined) + *ghci> :set -fbreak-on-exception + *ghci> :trace qsort ("abc" ++ undefined) “Stopped at _exception :: e - [] *Main> :hist + [] *ghci> :hist -1 : qsort.hs:3:24-38 -2 : qsort.hs:3:23-55 -3 : qsort.hs:(1,0)-(3,55) @@ -1895,14 +1880,14 @@ example: -5 : qsort.hs:2:15-46 -6 : qsort.hs:(1,0)-(3,55) - [] *Main> :back + [] *ghci> :back Logged breakpoint at qsort.hs:3:24-38 _result :: [a] as :: [a] a :: a - [-1: qsort.hs:3:24-38] *Main> :force as + [-1: qsort.hs:3:24-38] *ghci> :force as *** Exception: Prelude.undefined - [-1: qsort.hs:3:24-38] *Main> :print as + [-1: qsort.hs:3:24-38] *ghci> :print as as = 'b' : 'c' : (_t1::[Char]) The exception itself is bound to a new variable, ``_exception``. @@ -1957,9 +1942,9 @@ We set a breakpoint on ``map``, and call it. .. code-block:: none - *Main> :break 5 + *ghci> :break 5 Breakpoint 0 activated at map.hs:5:15-28 - *Main> map Just [1..5] + *ghci> map Just [1..5] Stopped at map.hs:(4,0)-(5,12) _result :: [b] x :: a @@ -1980,8 +1965,8 @@ part of ``f``. .. code-block:: none - *Main> seq x () - *Main> :print x + *ghci> seq x () + *ghci> :print x x = 1 We can check now that as expected, the type of ``x`` has been @@ -1989,9 +1974,9 @@ reconstructed, and with it the type of ``f`` has been too: .. code-block:: none - *Main> :t x + *ghci> :t x x :: Integer - *Main> :t f + *ghci> :t f f :: Integer -> b From here, we can apply f to any argument of type Integer and observe @@ -1999,28 +1984,28 @@ the results. .. code-block:: none - *Main> let b = f 10 - *Main> :t b + *ghci> let b = f 10 + *ghci> :t b b :: b - *Main> b + *ghci> b :1:0: Ambiguous type variable `b' in the constraint: `Show b' arising from a use of `print' at :1:0 - *Main> :p b + *ghci> :p b b = (_t2::a) - *Main> seq b () + *ghci> seq b () () - *Main> :t b + *ghci> :t b b :: a - *Main> :p b + *ghci> :p b b = Just 10 - *Main> :t b + *ghci> :t b b :: Maybe Integer - *Main> :t f + *ghci> :t f f :: Integer -> Maybe Integer - *Main> f 20 + *ghci> f 20 Just 20 - *Main> map f [1..5] + *ghci> map f [1..5] [Just 1, Just 2, Just 3, Just 4, Just 5] In the first application of ``f``, we had to do some more type @@ -2117,13 +2102,13 @@ by using the :ghc-flag:`-package ⟨pkg⟩` flag: GHCi, version 8.y.z: https://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Loading package readline-1.0 ... linking ... done. - Prelude> + ghci> The following command works to load new packages into a running GHCi: .. code-block:: none - Prelude> :set -package name + ghci> :set -package name But note that doing this will cause all currently loaded modules to be unloaded, and you'll be dumped back into the ``Prelude``. @@ -2256,7 +2241,7 @@ commonly used commands. listing with comments giving possible imports for each group of entries. Here is an example: :: - Prelude> :browse! Data.Maybe + ghci> :browse! Data.Maybe -- not currently imported Data.Maybe.catMaybes :: [Maybe a] -> [a] Data.Maybe.fromJust :: Maybe a -> a @@ -2333,16 +2318,16 @@ commonly used commands. .. code-block:: none - Prelude> :complete repl 0 "" + ghci> :complete repl 0 "" 0 470 "" - Prelude> :complete repl 5 "import For" + ghci> :complete repl 5 "import For" 5 21 "import " "Foreign" "Foreign.C" "Foreign.C.Error" "Foreign.C.String" "Foreign.C.Types" - Prelude> :complete repl 5-10 "import For" + ghci> :complete repl 5-10 "import For" 6 21 "import " "Foreign.C.Types" "Foreign.Concurrent" @@ -2350,16 +2335,16 @@ commonly used commands. "Foreign.ForeignPtr.Safe" "Foreign.ForeignPtr.Unsafe" "Foreign.Marshal" - Prelude> :complete repl 20- "import For" + ghci> :complete repl 20- "import For" 2 21 "import " "Foreign.StablePtr" "Foreign.Storable" - Prelude> :complete repl "map" + ghci> :complete repl "map" 3 3 "" "map" "mapM" "mapM_" - Prelude> :complete repl 5-10 "map" + ghci> :complete repl 5-10 "map" 0 3 "" .. ghci-cmd:: :continue @@ -2392,9 +2377,9 @@ commonly used commands. .. code-block:: none - Prelude> let date _ = Data.Time.getZonedTime >>= print >> return "" - Prelude> :def date date - Prelude> :date + ghci> let date _ = Data.Time.getZonedTime >>= print >> return "" + ghci> :def date date + ghci> :date 2017-04-10 12:34:56.93213581 UTC Here's an example of a command that takes an argument. It's a @@ -2402,16 +2387,16 @@ commonly used commands. .. code-block:: none - Prelude> let mycd d = System.Directory.setCurrentDirectory d >> return "" - Prelude> :def mycd mycd - Prelude> :mycd .. + ghci> let mycd d = System.Directory.setCurrentDirectory d >> return "" + ghci> :def mycd mycd + ghci> :mycd .. Or I could define a simple way to invoke "``ghc --make Main``" in the current directory: .. code-block:: none - Prelude> :def make (\_ -> return ":! ghc --make Main") + ghci> :def make (\_ -> return ":! ghc --make Main") We can define a command that reads GHCi input from a file. This might be useful for creating a set of bindings that we want to @@ -2419,8 +2404,8 @@ commonly used commands. .. code-block:: none - Prelude> :def . readFile - Prelude> :. cmds.ghci + ghci> :def . readFile + ghci> :. cmds.ghci Notice that we named the command ``:.``, by analogy with the "``.``" Unix shell command that does the same thing. @@ -2680,8 +2665,8 @@ commonly used commands. .. code-block:: none - Prelude> main = System.Environment.getArgs >>= print - Prelude> :main foo bar + ghci> main = System.Environment.getArgs >>= print + ghci> :main foo bar ["foo","bar"] We can also quote arguments which contains characters like spaces, @@ -2690,9 +2675,9 @@ commonly used commands. .. code-block:: none - Prelude> :main foo "bar baz" + ghci> :main foo "bar baz" ["foo","bar baz"] - Prelude> :main ["foo", "bar baz"] + ghci> :main ["foo", "bar baz"] ["foo","bar baz"] Finally, other functions can be called, either with the ``-main-is`` @@ -2700,13 +2685,13 @@ commonly used commands. .. code-block:: none - Prelude> foo = putStrLn "foo" >> System.Environment.getArgs >>= print - Prelude> bar = putStrLn "bar" >> System.Environment.getArgs >>= print - Prelude> :set -main-is foo - Prelude> :main foo "bar baz" + ghci> foo = putStrLn "foo" >> System.Environment.getArgs >>= print + ghci> bar = putStrLn "bar" >> System.Environment.getArgs >>= print + ghci> :set -main-is foo + ghci> :main foo "bar baz" foo ["foo","bar baz"] - Prelude> :run bar ["foo", "bar baz"] + ghci> :run bar ["foo", "bar baz"] bar ["foo","bar baz"] @@ -2870,8 +2855,8 @@ commonly used commands. .. code-block:: none - *Main> :def cond \expr -> return (":cmd if (" ++ expr ++ ") then return \"\" else return \":continue\"") - *Main> :set stop 0 :cond (x < 3) + *ghci> :def cond \expr -> return (":cmd if (" ++ expr ++ ") then return \"\" else return \":continue\"") + *ghci> :set stop 0 :cond (x < 3) Ignoring breakpoints for a specified number of iterations is also possible using similar techniques. @@ -3161,7 +3146,7 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say: .. code-block:: none - Prelude> :set -Wmissing-signatures + ghci> :set -Wmissing-signatures Any GHC command-line option that is designated as dynamic (see the table in :ref:`flag-reference`), may be set using :ghci-cmd:`:set`. To unset an @@ -3172,7 +3157,7 @@ option, you can set the reverse option: .. code-block:: none - Prelude> :set -Wno-incomplete-patterns -XNoMultiParamTypeClasses + ghci> :set -Wno-incomplete-patterns -XNoMultiParamTypeClasses :ref:`flag-reference` lists the reverse for each option where applicable. @@ -3222,7 +3207,7 @@ clean GHCi session we might see something like this: .. code-block:: none - Prelude> :seti + ghci> :seti base language is: Haskell2010 with the following modifiers: -XNoMonomorphismRestriction ===================================== ghc/GHCi/UI.hs ===================================== @@ -430,8 +430,8 @@ default_progname = "" default_stop = "" default_prompt, default_prompt_cont :: PromptFunction -default_prompt = generatePromptFunctionFromString "%s> " -default_prompt_cont = generatePromptFunctionFromString "%s| " +default_prompt = generatePromptFunctionFromString "ghci> " +default_prompt_cont = generatePromptFunctionFromString "| " default_args :: [String] default_args = [] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/086ef01813069fad84cafe81cab37527d41c8568 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/086ef01813069fad84cafe81cab37527d41c8568 You're receiving 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 23 10:52:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 06:52:49 -0400 Subject: [Git][ghc/ghc][master] Bump submodules Message-ID: <5f6b2901db8b2_80b3f84270dc5241390794f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 3 changed files: - libraries/Cabal - libraries/Win32 - libraries/bytestring Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb +Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit f059037820ce68c5f524b188496cab196d979950 +Subproject commit d68374423fa3d3edd6b776e412e4093cc69b5f64 ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit e043aacfc4202a59ccae8b8c8cf0e1ad83a3f209 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7385f7077c6258c2a76ae51b4ea80f6fa9c7015 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7385f7077c6258c2a76ae51b4ea80f6fa9c7015 You're receiving 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 23 11:23:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 07:23:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Remove the list of loaded modules from the ghci prompt Message-ID: <5f6b303d83c70_80b3f847274c51c1392109b@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 48513db9 by Sylvain Henry at 2020-09-23T07:23:34-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - 5d80b2ff by Sylvain Henry at 2020-09-23T07:23:34-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - 5fb53626 by Sylvain Henry at 2020-09-23T07:23:34-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - ab2fd7c0 by Hécate at 2020-09-23T07:23:35-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - libraries/Cabal - libraries/Win32 - libraries/base/.hlint.yaml - libraries/base/Control/Concurrent/Chan.hs - libraries/base/Control/Concurrent/QSem.hs - libraries/base/Control/Concurrent/QSemN.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/Data/String.hs - libraries/base/Debug/Trace.hs - libraries/base/Foreign/Marshal/Array.hs - libraries/base/Foreign/Marshal/Utils.hs - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/Environment.hs - libraries/base/GHC/Event/Array.hs - libraries/base/GHC/Event/Control.hs - libraries/base/GHC/Event/Manager.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a217d1de3de01168b33e2dde05dcc6e5ffef6c2...ab2fd7c08065b5faac0773a3432fdf00ca217696 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a217d1de3de01168b33e2dde05dcc6e5ffef6c2...ab2fd7c08065b5faac0773a3432fdf00ca217696 You're receiving 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 23 11:41:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 07:41:07 -0400 Subject: [Git][ghc/ghc][wip/T14620] WIP: Fix #14620 by introducing WW to detect more join points Message-ID: <5f6b34536c2b3_80b3f84963fba1013922238@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14620 at Glasgow Haskell Compiler / GHC Commits: e6ea5c5a by Sebastian Graf at 2020-09-23T13:40:57+02:00 WIP: Fix #14620 by introducing WW to detect more join points - - - - - 8 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Ppr.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -831,10 +831,14 @@ Now we can move the case inward and we only have to change the jump: (Core Lint would still check that the body of the join point has the right type; that type would simply not be reflected in the join id.) -Note [The polymorphism rule of join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Invariant 4 of Note [Invariants on join points] forbids a join point to be -polymorphic in its return type. That is, if its type is +Historic Note [The polymorphism rule of join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before we had Note [Join point worker/wrapper], we used to have as Invariant 4 +of Note [Invariants on join points] + + 4. The binding's type must not be polymorphic in its return type. + +That is, if its type is forall a1 ... ak. t1 -> ... -> tn -> r ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2984,9 +2984,6 @@ decideJoinPointHood NotTopLevel usage bndrs -- Invariant 2a: stable unfoldings -- See Note [Join points and INLINE pragmas] , ok_unfolding arity (realIdUnfolding bndr) - - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) = True | otherwise ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType , pushCoTyArg, pushCoValArg , idArityType, etaExpandAT ) -import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe ) +import GHC.Core.SimpleOpt ( tryJoinPointWW, tryJoinPointWWs ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) import GHC.Types.Basic @@ -1052,8 +1052,9 @@ simplExprF1 env (Case scrut bndr _ alts) cont , sc_env = env, sc_cont = cont }) simplExprF1 env (Let (Rec pairs) body) cont - | Just pairs' <- joinPointBindings_maybe pairs - = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' body cont + | Just (pairs', wrappers) <- tryJoinPointWWs (getInScope env) (exprType body) pairs + -- , null wrappers || pprTrace "simple join Rec" (ppr pairs'<+> ppr (exprType body)) True + = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' wrappers body cont | otherwise = {-#SCC "simplRecE" #-} simplRecE env pairs body cont @@ -1065,8 +1066,9 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont do { ty' <- simplType env ty ; simplExprF (extendTvSubst env bndr ty') body cont } - | Just (bndr', rhs') <- joinPointBinding_maybe bndr rhs - = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' body cont + | Just (bndr', rhs', wrappers) <- tryJoinPointWW (getInScope env) (exprType body) bndr rhs + -- , null wrappers || pprTrace "simple join NonRec" (ppr bndr' $$ ppr (idType bndr') $$ ppr (exprType body) $$ ppr (isJoinId bndr) $$ ppr wrappers) True + = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' wrappers body cont | otherwise = {-#SCC "simplNonRecE" #-} simplNonRecE env bndr (rhs, env) ([], body) cont @@ -1684,33 +1686,41 @@ type MaybeJoinCont = Maybe SimplCont -- Just k => This is a join binding with continuation k -- See Note [Rules and unfolding for join points] -simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplNonRecJoinPoint env bndr rhs body cont +preInlineJoinWrappers :: SimplEnv -> [(InId, InExpr)] -> SimplEnv +preInlineJoinWrappers env binds + = foldl' (\env (b,r) -> extendIdSubst env b (mkContEx env r)) env' binds + where + env' = addNewInScopeIds env (map fst binds) + +simplNonRecJoinPoint + :: SimplEnv -> InId -> InExpr -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecJoinPoint env bndr rhs wrappers body cont | ASSERT( isJoinId bndr ) True - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env + , ASSERT( wrappers `lengthAtMost` 1 ) True + , Just env1 <- preInlineUnconditionally env NotTopLevel bndr rhs env = do { tick (PreInlineUnconditionally bndr) - ; simplExprF env' body cont } - - | otherwise - = wrapJoinCont env cont $ \ env cont -> - do { -- We push join_cont into the join RHS and the body; - -- and wrap wrap_cont around the whole thing - ; let mult = contHoleScaling cont - res_ty = contResultType cont - ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty - ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) - ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env - ; (floats2, body') <- simplExprF env3 body cont - ; return (floats1 `addFloats` floats2, body') } + ; let env2 = preInlineJoinWrappers env1 wrappers + ; simplExprF env2 body cont } + | otherwise + = wrapJoinCont env cont $ \ env cont -> + do { -- We push join_cont into the join RHS and the body; + -- and wrap wrap_cont around the whole thing + ; let mult = contHoleScaling cont + res_ty = contResultType cont + ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) + ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env + ; let env4 = preInlineJoinWrappers env3 wrappers + ; (floats2, body') <- simplExprF env4 body cont + ; return (floats1 `addFloats` floats2, body') } ------------------ -simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)] - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplRecJoinPoint env pairs body cont +simplRecJoinPoint + :: SimplEnv -> [(InId, InExpr)] -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplRecJoinPoint env pairs wrappers body cont = wrapJoinCont env cont $ \ env cont -> do { let bndrs = map fst pairs mult = contHoleScaling cont @@ -1718,8 +1728,9 @@ simplRecJoinPoint env pairs body cont ; env1 <- simplRecJoinBndrs env bndrs mult res_ty -- NB: bndrs' don't have unfoldings or rules -- We add them as we go down - ; (floats1, env2) <- simplRecBind env1 NotTopLevel (Just cont) pairs - ; (floats2, body') <- simplExprF env2 body cont + ; let env2 = preInlineJoinWrappers env1 wrappers + ; (floats1, env3) <- simplRecBind env2 NotTopLevel (Just cont) pairs + ; (floats2, body') <- simplExprF env3 body cont ; return (floats1 `addFloats` floats2, body') } -------------------- ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Core.SimpleOpt ( SimpleOpts (..), defaultSimpleOpts, @@ -13,7 +14,7 @@ module GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr, simpleOptExprWith, -- ** Join points - joinPointBinding_maybe, joinPointBindings_maybe, + tryJoinPointWW, tryJoinPointWWs, -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, @@ -36,7 +37,7 @@ import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) ) -import GHC.Types.Var ( isNonCoVarId ) +import GHC.Types.Var ( isNonCoVarId, setVarType, VarBndr (..) ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core.DataCon @@ -44,7 +45,11 @@ import GHC.Types.Demand( etaConvertStrictSig ) import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) +import qualified GHC.Core.Type as Type import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) +import GHC.Core.TyCo.Rep ( TyCoBinder (..) ) +import GHC.Core.Multiplicity +import GHC.Core.Unify ( tcMatchTy ) import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Types.Basic @@ -52,8 +57,10 @@ import GHC.Unit.Module ( Module ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Data.Maybe ( orElse ) +import GHC.Utils.Monad ( mapAccumLM ) +import GHC.Data.Maybe import GHC.Data.FastString +import Data.Bifunctor ( first ) import Data.List import qualified Data.ByteString as BS @@ -172,14 +179,14 @@ simpleOptPgm opts this_mod binds rules = -- hence paying just a substitution do_one (env, binds') bind - = case simple_opt_bind env bind TopLevel of + = case simple_opt_bind env bind of (env', Nothing) -> (env', binds') (env', Just bind') -> (env', bind':binds') -- In these functions the substitution maps InVar -> OutExpr ---------------------- -type SimpleClo = (SimpleOptEnv, InExpr) +type SimpleClo = (SimpleOptEnv, InExpr) -- Like SimplSR's ContEx data SimpleOptEnv = SOE { soe_co_opt_opts :: !OptCoercionOpts @@ -191,7 +198,8 @@ data SimpleOptEnv , soe_inl :: IdEnv SimpleClo -- ^ Deals with preInlineUnconditionally; things -- that occur exactly once and are inlined - -- without having first been simplified + -- without having first been simplified or + -- substituted, thus the domain is InBndrs , soe_subst :: Subst -- ^ Deals with cloning; includes the InScopeSet @@ -247,9 +255,10 @@ simple_opt_expr env expr go (Lit lit) = Lit lit go (Tick tickish e) = mkTick (substTickish subst tickish) (go e) go (Cast e co) = mk_cast (go e) (go_co co) - go (Let bind body) = case simple_opt_bind env bind NotTopLevel of - (env', Nothing) -> simple_opt_expr env' body - (env', Just bind) -> Let bind (simple_opt_expr env' body) + go (Let bind body) = + case simple_opt_local_bind env (exprType body) bind of + (env', Nothing) -> simple_opt_expr env' body + (env', Just bind) -> Let bind (simple_opt_expr env' body) go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) @@ -351,7 +360,7 @@ simple_app env (Tick t e) as -- However, do /not/ do this transformation for join points -- See Note [simple_app and join points] simple_app env (Let bind body) args - = case simple_opt_bind env bind NotTopLevel of + = case simple_opt_local_bind env (exprType body) bind of (env', Nothing) -> simple_app env' body args (env', Just bind') | isJoinBind bind' -> finish_app env expr' args @@ -369,29 +378,87 @@ finish_app env fun (arg:args) = finish_app env (App fun (simple_opt_clo env arg)) args ---------------------- -simple_opt_bind :: SimpleOptEnv -> InBind -> TopLevelFlag - -> (SimpleOptEnv, Maybe OutBind) -simple_opt_bind env (NonRec b r) top_level - = (env', case mb_pr of - Nothing -> Nothing - Just (b,r) -> Just (NonRec b r)) +extendInlEnv :: SimpleOptEnv -> InBndr -> SimpleClo -> SimpleOptEnv +-- Like GHC.Core.Opt.Simplify.Env.extendIdSubst +extendInlEnv env@(SOE { soe_inl = inl_env }) bndr clo + = ASSERT2( isId bndr && not (isCoVar bndr), ppr bndr ) + env { soe_inl = extendVarEnv inl_env bndr clo } + +extendInScopeEnv :: SimpleOptEnv -> [InBndr] -> SimpleOptEnv +extendInScopeEnv env@(SOE { soe_subst = Subst in_scope ids tvs cos }) bndrs + = env { soe_subst = Subst (extendInScopeSetList in_scope bndrs) ids tvs cos } + +tryJoinPointWWs :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe ([(InBndr, InExpr)], [(InBndr, InExpr)]) +tryJoinPointWWs in_scope body_ty binds + = foldMap go <$> joinPointBindings_maybe in_scope body_ty binds where - (b', r') = joinPointBinding_maybe b r `orElse` (b, r) - (env', mb_pr) = simple_bind_pair env b' Nothing (env,r') top_level + go jph = ([(join_bndr jph, join_rhs jph)], join_wrapper jph) + join_wrapper jph at JoinPointAfterMono{} -- Rare: A join point after we inline a wrapper + = [(join_wrapper_bndr jph, join_wrapper_body jph)] + join_wrapper DefinitelyJoinPoint{} -- Common: Regular join point. No wrapper + = [] + +tryJoinPointWW :: InScopeSet -> Type -> InBndr -> InExpr -> Maybe (InBndr, InExpr, [(InBndr, InExpr)]) +tryJoinPointWW in_scope body_ty b r + | Just ([(b', r')], wrappers) <- tryJoinPointWWs in_scope body_ty [(b, r)] + = ASSERT( wrappers `lengthAtMost` 1 ) + Just (b', r', wrappers) + | otherwise + = Nothing -simple_opt_bind env (Rec prs) top_level - = (env'', res_bind) +pair_to_non_rec + :: (SimpleOptEnv, Maybe (OutBndr, OutExpr)) + -> (SimpleOptEnv, Maybe OutBind) +pair_to_non_rec (env, mb_pr) = (env, uncurry NonRec <$> mb_pr) + +simple_opt_local_bind + :: SimpleOptEnv -> Type -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_local_bind env body_ty (NonRec b r) + | (b', r', wrappers) <- tryJoinPointWW (substInScope (soe_subst env) `extendInScopeSet` b) body_ty b r `orElse` (b, r, []) + -- , null wrappers || pprTrace "simple_opt_local_bind:join" (ppr b <+> ppr (idType b) <+> ppr body_ty) True + = -- pprTraceWith "simple_opt_local_bind" (\(env', mb_bind) -> ppr b <+> (case mb_bind of Nothing -> text "inlined" $$ ppr env'; Just _ -> text "not inlined")) $ + first (pre_inline_join_wrappers wrappers) + $ pair_to_non_rec + $ simple_bind_pair env b' Nothing (env,r') NotTopLevel + +simple_opt_local_bind env body_ty (Rec prs) + --- | null wrappers || pprTrace "simple_opt_local_bind:joinrec" (ppr prs <+> ppr body_ty) True + = (env3, res_bind) where - res_bind = Just (Rec (reverse rev_prs')) - prs' = joinPointBindings_maybe prs `orElse` prs - (env', bndrs') = subst_opt_bndrs env (map fst prs') - (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs') - do_pr (env, prs) ((b,r), b') + res_bind = Just (Rec (reverse rev_prs')) + (prs', wrappers) = tryJoinPointWWs (substInScope (soe_subst env)) body_ty prs `orElse` (prs, []) + (env1, bndrs') = subst_opt_bndrs env (map fst prs') + env2 = pre_inline_join_wrappers wrappers env1 + (env3, rev_prs') = foldl' simpl_pr (env2, []) (prs' `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') = (env', case mb_pr of Just pr -> pr : prs Nothing -> prs) where - (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) top_level + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) NotTopLevel + +pre_inline_join_wrappers :: [(InBndr, InExpr)] -> SimpleOptEnv -> SimpleOptEnv +pre_inline_join_wrappers binds env + = foldl' (\env (b,r) -> extendInlEnv env b (env, r)) env' binds + where + env' = extendInScopeEnv env (map fst binds) + +simple_opt_bind :: SimpleOptEnv -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_bind env (NonRec b r) + = pair_to_non_rec (simple_bind_pair env b Nothing (env,r) TopLevel) + +simple_opt_bind env (Rec prs) + = (env'', res_bind) + where + res_bind = Just (Rec (reverse rev_prs')) + (env', bndrs') = subst_opt_bndrs env (map fst prs) + (env'', rev_prs') = foldl' simpl_pr (env', []) (prs `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') + = (env', case mb_pr of + Just pr -> pr : prs + Nothing -> prs) + where + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) TopLevel ---------------------- simple_bind_pair :: SimpleOptEnv @@ -796,39 +863,261 @@ A more common case is when and again its arity increases (#15517) -} - --- | Returns Just (bndr,rhs) if the binding is a join point: --- If it's a JoinId, just return it +-- | Indicates that a binding can be transformed into a join point. +data JoinPointHood + = DefinitelyJoinPoint -- ^ A join point by nature + { join_bndr :: !InBndr + , join_rhs :: !InExpr } + | JoinPointAfterMono + -- ^ A join point after we have instantiated the forall binders occuring in + -- the result type. See Note [Join point worker/wrapper]. + { join_bndr :: !InBndr + , join_rhs :: !InExpr + , join_wrapper_bndr :: !InBndr + -- ^ the bndr of a wrapper that needs to be inlined unconditionally + , join_wrapper_body :: !InExpr } + +-- | An element of the result list of 'matchJoinResTy'. +-- Corresponds to a join binder of what is going to be the new join point. +-- See Note [Join point worker/wrapper]. +data JoinWorkerBinder + = InstBinder !Type + -- ^ A binder that could be instantiated to the given type by matching against + -- the res ty. The corresponding binder will be dropped for the new join point + | SubstBinder !TyCoBinder + -- ^ A join binder that was not instantiated by matching against the res ty. + -- But since other join binders might have been instantiated, the binder's + -- type might have changed. + +instance Outputable JoinWorkerBinder where + ppr (InstBinder ty) = text "Inst" <+> ppr ty + ppr (SubstBinder bndr) = text "Subst" <+> ppr bndr + +isSubstBinder :: JoinWorkerBinder -> Bool +isSubstBinder SubstBinder{} = True +isSubstBinder _ = False + +-- | Returns Just jph if the binding is a join point: +-- If it's a JoinId, just return @DefinitelyJoinPoint bndr rhs at . -- If it's not yet a JoinId but is always tail-called, -- make it into a JoinId and return it. -- In the latter case, eta-expand the RHS if necessary, to make the --- lambdas explicit, as is required for join points +-- lambdas explicit, as is required for join points. +-- If the join point is not result type polymorphic, return +-- @DefinitelyJoinPoint bndr rhs at . +-- If the join point is result type polymorphic, monomorphise it first, +-- returning @JoinPointAfterMono bndr rhs worker_bndr worker_rhs at . +-- Call sites then have to unconditionally inline the @bndr@/@rhs at . +-- See Note [Join point worker/wrapper]. -- -- Precondition: the InBndr has been occurrence-analysed, -- so its OccInfo is valid -joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr) -joinPointBinding_maybe bndr rhs - | not (isId bndr) - = Nothing - - | isJoinId bndr - = Just (bndr, rhs) +joinPointBindings_maybe :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe [JoinPointHood] +-- See Note [Join point worker/wrapper]. +joinPointBindings_maybe in_scope body_type binds + = snd <$> mapAccumLM go (extendInScopeSetList in_scope (map fst binds)) binds + where + go :: InScopeSet -> (InBndr, InExpr) -> Maybe (InScopeSet, JoinPointHood) + go in_scope (bndr, rhs) + | not (isId bndr) + = Nothing + + | isJoinId bndr + = Just (in_scope, DefinitelyJoinPoint bndr rhs) + + | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) + , not (exprIsTrivial rhs) + , (lam_bndrs, rhs') <- etaExpandToJoinPoint join_arity rhs + , let eta_rhs' = mkLams lam_bndrs rhs' + , let inst_tys = matchJoinResTy join_arity (idType bndr) body_type + , let new_join_arity = count isSubstBinder inst_tys + , let no_mono = new_join_arity == join_arity + , let worker_body = mk_worker_body lam_bndrs inst_tys eta_rhs' + -- we need an in-scope set as if the worker was defined inside the RHS of the wrapper (as is the case with SAT) + , let in_scope' = extendInScopeSetList in_scope lam_bndrs + , let new_bndr = uniqAway in_scope' bndr -- only used in else branch + `setIdType` exprType worker_body + , let wrapper_body = mk_wrapper_body new_bndr lam_bndrs inst_tys + , let wrapper_bndr = bndr + -- , no_mono || pprTrace "always tail called:" (vcat [ppr in_scope', ppr bndr, ppr (idType bndr), ppr body_type, ppr rhs, ppr new_bndr, ppr (exprType worker_body), ppr join_arity, ppr inst_tys, ppr new_bndr, ppr wrapper_body, ppr worker_body]) True + = Just $! if no_mono + then ( in_scope + , DefinitelyJoinPoint + { join_bndr = adjust_id_info bndr lam_bndrs join_arity + , join_rhs = eta_rhs' } ) + else ( extendInScopeSet in_scope new_bndr + , JoinPointAfterMono + { join_bndr = adjust_id_info new_bndr lam_bndrs new_join_arity + , join_rhs = worker_body + , join_wrapper_bndr = wrapper_bndr + , join_wrapper_body = wrapper_body } ) - | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) - , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs - , let str_sig = idStrictness bndr - str_arity = count isId bndrs -- Strictness demands are for Ids only - join_bndr = bndr `asJoinId` join_arity - `setIdStrictness` etaConvertStrictSig str_arity str_sig - = Just (join_bndr, mkLams bndrs body) + | otherwise + = Nothing + + adjust_id_info :: InBndr -> [InBndr] -> JoinArity -> InBndr + adjust_id_info bndr lam_bndrs join_arity = zapStableUnfolding $ -- TODO: Discuss! Type errors otherwise. + let str_sig = idStrictness bndr + str_arity = count isId lam_bndrs -- Strictness demands are for Ids only + in bndr `asJoinId` join_arity + `setIdStrictness` etaConvertStrictSig str_arity str_sig + + mk_wrapper_body :: InBndr -> [InBndr] -> [JoinWorkerBinder] -> InExpr + -- See Note [Join point worker/wrapper]. + mk_wrapper_body new_bndr lam_bndrs inst_tys + = ASSERT( lam_bndrs `equalLength` inst_tys ) + -- pprTraceWith "mk_wrapper_body" (\e -> ppr lam_bndrs $$ ppr inst_tys $$ ppr e) $ + go (Var new_bndr) $ zipEqual "mk_wrapper_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder{}):prs) -- non-instantiated parameter + | isId lb -- value paramater xs + = Lam lb (go (App e (Var lb)) prs) + | otherwise -- type paramater @b + = Lam lb (go (App e (Type (mkTyVarTy lb))) prs) + go e ((lb,InstBinder{}):prs) -- instantiated parameter, @a or @c + = ASSERT( isTyVar lb ) + Lam lb (go e prs) + + mk_worker_body :: [InBndr] -> [JoinWorkerBinder] -> InExpr -> InExpr + -- See Note [Join point worker/wrapper]. + mk_worker_body lam_bndrs inst_tys rhs + = -- pprTraceWith "mk_worker_body" (\e -> ppr e) $ + go rhs $ zipEqual "mk_worker_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder bndr):prs) -- non-instantiated parameter + | Anon _ (Scaled _ ty) <- bndr -- value paramater xs + , let lb' = lb `setIdType` ty + = Lam lb' (go (App e (Var lb')) prs) + | Named (binderVar -> tcv) <- bndr -- type paramater @b + = Lam tcv (go (App e (Type (mkTyVarTy tcv))) prs) + go e ((_ ,InstBinder ty):prs) -- instantiated paramater, @a or @c + = go (App e (Type ty)) prs + +-- | Figures out how to monomorphise the result type of a join point. +-- +-- @matchJoinResTy ja join_ty body_ty@ computes the result type of @join_ty@ by +-- skipping @ja@ binders and then matches it against @body_ty at . +-- If a forall binder @a@ is mentioned in the resulting substitution @subst@, +-- the corresponding entry in the returned list is @InstBinder (subst a)@. +-- See Note [Join point worker/wrapper]. +-- +-- Postcondition: The returned list has length @ja at . +matchJoinResTy + :: JoinArity -- ^ Number of binders to skip + -> Type -- ^ Type of the join point + -> Type -- ^ Type of the join body + -> [JoinWorkerBinder] -- ^ An entry for each join binder, + -- InstBinder ty <=> instantiates corresponding forall to ty +matchJoinResTy orig_ar orig_ty body_ty = snd (go init_in_scope orig_ar orig_ty) + where + init_in_scope = mkInScopeSet $ tyCoVarsOfType body_ty `unionVarSet` tyCoVarsOfType orig_ty - | otherwise - = Nothing + go :: InScopeSet -> Int -> Type -> (TCvSubst, [JoinWorkerBinder]) + go in_scope 0 res_ty = (TCvSubst in_scope tvs cvs, []) + where + TCvSubst _ tvs cvs = expectJust "matchJoinResTy" $ tcMatchTy res_ty body_ty + + go in_scope n ty + | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty + = case arg_bndr of + Anon f (Scaled m ty) + | (subst, inst_tys) <- go in_scope (n-1) res_ty + -> (subst, SubstBinder (Anon f (Scaled m (Type.substTy subst ty))):inst_tys) + Named (Bndr tcv vis) + | isTyVar tcv', Just ty <- lookupTyVar subst tcv' + -> (subst', InstBinder ty: inst_tys) + | otherwise + -> (subst', SubstBinder (Named (Bndr subst_tcv vis)) : inst_tys) + where + tcv' = uniqAway in_scope tcv + in_scope' = extendInScopeSet in_scope tcv' + (subst, inst_tys) = go in_scope' (n-1) res_ty + subst' = delTCvSubst subst tcv' + subst_tcv = tcv' `setVarType` Type.substTy subst' (varType tcv') -joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)] -joinPointBindings_maybe bndrs - = mapM (uncurry joinPointBinding_maybe) bndrs + go _ _ _ = pprPanic "matchJoinResTy" (ppr orig_ar <+> ppr orig_ty) +{- Note [Join point worker/wrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some let bindings that are 'AlwaysTailCalled' still need a bit of work to become +a join point. Here's an example: + + let f :: forall a b. [a] -> forall c. b -> Maybe c -> [(a,c)] + f = + in ( :: [(Bool, Char)]) + +Suppose @f@ is 'AlwaysTailCalled' in . Its result type is polymorphic, +which is exactly the situation as in +Historic Note [The polymorphism rule of join points]. +That Note also explains why we can't just turn @f@ into join point untouched. + +So we need a transformation that monomorphises @f@ for its result type. Since we +have available the type of (the soon to be join-) , we can match @[(a,c)]@ +against @[(Bool, Char)]@ to get a substitution @[a ↦ Bool, c ↦ Char]@. We then +apply this substitution to the tyco binders in the type of @f@, as we ascend +from the result type: + + * @Maybe c@ is substituted to @Maybe Char@ ('SubstBinder') + * @b@ is substituted to @b@ (unchanged, likewise 'SubstBinder') + * @forall c@ is in the domain of the substitution and thus will be + instantiated ('InstBinder') + * @[a]@ is substituted to @[Bool]@ ('SubstBinder') + * @forall b@ is substituted (note that in general its kind might mention @a@) + to @forall b@ ('SubstBinder') + * @forall a@ is in the domain of the substitution and thus will be + instantiated ('InstBinder') + +Figuring out this list of 'JoinWorkerBinder's (which is the +'SubstBinder'/'InstBinder') is the job of 'matchJoinResTy'. +In the simple, non-polymorphic case, it returns a list of 'SubstBinder's, one +for each join binder. Otherwise, there is at least one 'InstBinder' that +indicates monorphisation of a polymorphic join result type. + +The challenge is in rewriting all call sites of @f@ to match its new type, +dropping the instantiated type arguments. A typical use case for the +worker/wrapper transformation. Thus, we make @f@ a wrapper that rewrites to the +new worker join point f': + + let f :: forall a b. [a] -> forall c. b -> Maybe c -> [(a,c)] + f = \@a @b (xs :: [a]) @c b (mc :: Maybe c) -> f' @b xs b mc + f' :: forall b. [Bool] -> b -> Maybe Char -> [(Bool, Char)] + f' = \@b (xs :: [Bool]) b mb -> @Bool @b xs @Char b mb + in ( :: [(Bool, Char)]) + +Take note that @f@'s type did not change, but its new RHS is now actually +ill-typed. This doesn't matter as long as we manage to inline the wrapper +unconditionally at its call sites in , where the arguments for @a@ and @c@ +will always be @Bool@ and @Char at . + +The join point worker @f'@ similarly instantiates @a@ and @c@ to @Bool@ and + at Char@. Its result type is monomorphic and it can be made into a join point. + +The worker/wrapper split is carried out by 'joinPointBinding_maybe', but only if +there are any 'InstBinder's at all (In which case it returns the result + at JoinPointAfterMono@). +Equipped with the 'matchJoinResTy' result (InstBinder = I, SubstBinder = S) + + [I Bool, S (b::*), S (_::[Bool]), I Char, S (_::b), S (_::Maybe Char)] + +It builds the wrapper body of @f@ by applying the new worker binder @f'@ to + + * Nothing if the corresponding 'JoinWorkerBinder' is @I _@ + * @b@ if the corresponding 'JoinWorkerBinder' is @S _@ and @b@ is the old + lambda binder + +It builds the worker body of @f'@ by applying the to + + * @ty@ if the corresponding 'JoinWorkerBinder' is @I ty@ + * @tv@ if the corresponding 'JoinWorkerBinder' is @S (tv::..)@ (Named binder) + * @b@ if the corresponding 'JoinWorkerBinder' is @S (_::ty)@ (Anon binder) + and @b@ is the old lambda binder with its type updated to @ty at . + +The result of @joinPointBinding_maybe@ is ultimately exported via @tryJoinWW@ +and is used in the simple optimiser as well as the Simplifier, which both +inline the join point wrapper unconditionally (if present). +-} {- ********************************************************************* * * @@ -1342,5 +1631,3 @@ exprIsLambda_maybe (in_scope_set, id_unf) e exprIsLambda_maybe _ _e = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e]) Nothing - - ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Core.TyCo.Subst getTvSubstEnv, getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs, isInScope, notElemTCvSubst, - setTvSubstEnv, setCvSubstEnv, zapTCvSubst, + setTvSubstEnv, setCvSubstEnv, zapTCvSubst, delTCvSubst, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendTCvSubstWithClone, extendCvSubst, extendCvSubstWithClone, @@ -308,6 +308,23 @@ setCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv zapTCvSubst :: TCvSubst -> TCvSubst zapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv +delTCvSubst :: TCvSubst -> Var -> TCvSubst +delTCvSubst subst v + | isTyVar v + = delTvSubst subst v + | isCoVar v + = delCvSubst subst v + | otherwise + = pprPanic "delTCvSubst" (ppr v) + +delTvSubst :: TCvSubst -> TyVar -> TCvSubst +delTvSubst (TCvSubst in_scope tenv cenv) tv + = TCvSubst in_scope (delVarEnv tenv tv) cenv + +delCvSubst :: TCvSubst -> CoVar -> TCvSubst +delCvSubst (TCvSubst in_scope tenv cenv) cv + = TCvSubst in_scope tenv (delVarEnv cenv cv) + extendTCvInScope :: TCvSubst -> Var -> TCvSubst extendTCvInScope (TCvSubst in_scope tenv cenv) var = TCvSubst (extendInScopeSet in_scope var) tenv cenv ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -193,7 +193,7 @@ module GHC.Core.Type ( zipTCvSubst, notElemTCvSubst, getTvSubstEnv, setTvSubstEnv, - zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs, + zapTCvSubst, delTCvSubst, getTCvInScope, getTCvSubstRangeFVs, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendCvSubst, extendTvSubst, extendTvSubstBinderAndInScope, ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -276,7 +276,7 @@ applyTypeToArgs e op_ty args go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args go op_ty (_ : args) | Just (_, _, res_ty) <- splitFunTy_maybe op_ty = go res_ty args - go _ args = pprPanic "applyTypeToArgs" (panic_msg args) + go op_ty args = pprPanic "applyTypeToArgs" (panic_msg op_ty args) -- go_ty_args: accumulate type arguments so we can -- instantiate all at once with piResultTys @@ -287,8 +287,9 @@ applyTypeToArgs e op_ty args go_ty_args op_ty rev_tys args = go (piResultTys op_ty (reverse rev_tys)) args - panic_msg as = vcat [ text "Expression:" <+> pprCoreExpr e + panic_msg ot as = vcat [ text "Expression:" <+> pprCoreExpr e , text "Type:" <+> ppr op_ty + , text "Type':" <+> ppr ot , text "Args:" <+> ppr args , text "Args':" <+> ppr as ] @@ -2622,4 +2623,3 @@ isUnsafeEqualityProof e = idName v == unsafeEqualityProofName | otherwise = False - ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Driver.Ppr , pprTraceWithFlags , pprTraceM , pprTraceDebug + , pprTraceWith , pprTraceIt , pprSTrace , pprTraceException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ea5c5acff2c58d2b09fe18a4cc45a9f46ecd70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6ea5c5acff2c58d2b09fe18a4cc45a9f46ecd70 You're receiving 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 23 11:44:40 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 07:44:40 -0400 Subject: [Git][ghc/ghc][wip/T14620] WIP: Fix #14620 by introducing WW to detect more join points Message-ID: <5f6b3528160d0_80b102bf9d41392437a@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14620 at Glasgow Haskell Compiler / GHC Commits: 66ec7c65 by Sebastian Graf at 2020-09-23T13:44:30+02:00 WIP: Fix #14620 by introducing WW to detect more join points - - - - - 8 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Ppr.hs Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -831,10 +831,14 @@ Now we can move the case inward and we only have to change the jump: (Core Lint would still check that the body of the join point has the right type; that type would simply not be reflected in the join id.) -Note [The polymorphism rule of join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Invariant 4 of Note [Invariants on join points] forbids a join point to be -polymorphic in its return type. That is, if its type is +Historic Note [The polymorphism rule of join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before we had Note [Join point worker/wrapper], we used to have as Invariant 4 +of Note [Invariants on join points] + + 4. The binding's type must not be polymorphic in its return type. + +That is, if its type is forall a1 ... ak. t1 -> ... -> tn -> r ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2984,9 +2984,6 @@ decideJoinPointHood NotTopLevel usage bndrs -- Invariant 2a: stable unfoldings -- See Note [Join points and INLINE pragmas] , ok_unfolding arity (realIdUnfolding bndr) - - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) = True | otherwise ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType , pushCoTyArg, pushCoValArg , idArityType, etaExpandAT ) -import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe ) +import GHC.Core.SimpleOpt ( tryJoinPointWW, tryJoinPointWWs ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) import GHC.Types.Basic @@ -1052,8 +1052,9 @@ simplExprF1 env (Case scrut bndr _ alts) cont , sc_env = env, sc_cont = cont }) simplExprF1 env (Let (Rec pairs) body) cont - | Just pairs' <- joinPointBindings_maybe pairs - = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' body cont + | Just (pairs', wrappers) <- tryJoinPointWWs (getInScope env) (exprType body) pairs + -- , null wrappers || pprTrace "simple join Rec" (ppr pairs'<+> ppr (exprType body)) True + = {-#SCC "simplRecJoinPoin" #-} simplRecJoinPoint env pairs' wrappers body cont | otherwise = {-#SCC "simplRecE" #-} simplRecE env pairs body cont @@ -1065,8 +1066,9 @@ simplExprF1 env (Let (NonRec bndr rhs) body) cont do { ty' <- simplType env ty ; simplExprF (extendTvSubst env bndr ty') body cont } - | Just (bndr', rhs') <- joinPointBinding_maybe bndr rhs - = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' body cont + | Just (bndr', rhs', wrappers) <- tryJoinPointWW (getInScope env) (exprType body) bndr rhs + -- , null wrappers || pprTrace "simple join NonRec" (ppr bndr' $$ ppr (idType bndr') $$ ppr (exprType body) $$ ppr (isJoinId bndr) $$ ppr wrappers) True + = {-#SCC "simplNonRecJoinPoint" #-} simplNonRecJoinPoint env bndr' rhs' wrappers body cont | otherwise = {-#SCC "simplNonRecE" #-} simplNonRecE env bndr (rhs, env) ([], body) cont @@ -1684,33 +1686,41 @@ type MaybeJoinCont = Maybe SimplCont -- Just k => This is a join binding with continuation k -- See Note [Rules and unfolding for join points] -simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplNonRecJoinPoint env bndr rhs body cont +preInlineJoinWrappers :: SimplEnv -> [(InId, InExpr)] -> SimplEnv +preInlineJoinWrappers env binds + = foldl' (\env (b,r) -> extendIdSubst env b (mkContEx env r)) env' binds + where + env' = addNewInScopeIds env (map fst binds) + +simplNonRecJoinPoint + :: SimplEnv -> InId -> InExpr -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplNonRecJoinPoint env bndr rhs wrappers body cont | ASSERT( isJoinId bndr ) True - , Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env + , ASSERT( wrappers `lengthAtMost` 1 ) True + , Just env1 <- preInlineUnconditionally env NotTopLevel bndr rhs env = do { tick (PreInlineUnconditionally bndr) - ; simplExprF env' body cont } - - | otherwise - = wrapJoinCont env cont $ \ env cont -> - do { -- We push join_cont into the join RHS and the body; - -- and wrap wrap_cont around the whole thing - ; let mult = contHoleScaling cont - res_ty = contResultType cont - ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty - ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) - ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env - ; (floats2, body') <- simplExprF env3 body cont - ; return (floats1 `addFloats` floats2, body') } + ; let env2 = preInlineJoinWrappers env1 wrappers + ; simplExprF env2 body cont } + | otherwise + = wrapJoinCont env cont $ \ env cont -> + do { -- We push join_cont into the join RHS and the body; + -- and wrap wrap_cont around the whole thing + ; let mult = contHoleScaling cont + res_ty = contResultType cont + ; (env1, bndr1) <- simplNonRecJoinBndr env bndr mult res_ty + ; (env2, bndr2) <- addBndrRules env1 bndr bndr1 (Just cont) + ; (floats1, env3) <- simplJoinBind env2 cont bndr bndr2 rhs env + ; let env4 = preInlineJoinWrappers env3 wrappers + ; (floats2, body') <- simplExprF env4 body cont + ; return (floats1 `addFloats` floats2, body') } ------------------ -simplRecJoinPoint :: SimplEnv -> [(InId, InExpr)] - -> InExpr -> SimplCont - -> SimplM (SimplFloats, OutExpr) -simplRecJoinPoint env pairs body cont +simplRecJoinPoint + :: SimplEnv -> [(InId, InExpr)] -> [(InId, InExpr)] -> InExpr -> SimplCont + -> SimplM (SimplFloats, OutExpr) +simplRecJoinPoint env pairs wrappers body cont = wrapJoinCont env cont $ \ env cont -> do { let bndrs = map fst pairs mult = contHoleScaling cont @@ -1718,8 +1728,9 @@ simplRecJoinPoint env pairs body cont ; env1 <- simplRecJoinBndrs env bndrs mult res_ty -- NB: bndrs' don't have unfoldings or rules -- We add them as we go down - ; (floats1, env2) <- simplRecBind env1 NotTopLevel (Just cont) pairs - ; (floats2, body') <- simplExprF env2 body cont + ; let env2 = preInlineJoinWrappers env1 wrappers + ; (floats1, env3) <- simplRecBind env2 NotTopLevel (Just cont) pairs + ; (floats2, body') <- simplExprF env3 body cont ; return (floats1 `addFloats` floats2, body') } -------------------- ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Core.SimpleOpt ( SimpleOpts (..), defaultSimpleOpts, @@ -13,7 +14,7 @@ module GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr, simpleOptExprWith, -- ** Join points - joinPointBinding_maybe, joinPointBindings_maybe, + tryJoinPointWW, tryJoinPointWWs, -- ** Predicates on expressions exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe, @@ -36,7 +37,7 @@ import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) ) -import GHC.Types.Var ( isNonCoVarId ) +import GHC.Types.Var ( isNonCoVarId, setVarType, VarBndr (..) ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core.DataCon @@ -44,7 +45,11 @@ import GHC.Types.Demand( etaConvertStrictSig ) import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList , isInScope, substTyVarBndr, cloneTyVarBndr ) +import qualified GHC.Core.Type as Type import GHC.Core.Coercion hiding ( substCo, substCoVarBndr ) +import GHC.Core.TyCo.Rep ( TyCoBinder (..) ) +import GHC.Core.Multiplicity +import GHC.Core.Unify ( tcMatchTy ) import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Types.Basic @@ -52,8 +57,10 @@ import GHC.Unit.Module ( Module ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc -import GHC.Data.Maybe ( orElse ) +import GHC.Utils.Monad ( mapAccumLM ) +import GHC.Data.Maybe import GHC.Data.FastString +import Data.Bifunctor ( first ) import Data.List import qualified Data.ByteString as BS @@ -172,14 +179,14 @@ simpleOptPgm opts this_mod binds rules = -- hence paying just a substitution do_one (env, binds') bind - = case simple_opt_bind env bind TopLevel of + = case simple_opt_bind env bind of (env', Nothing) -> (env', binds') (env', Just bind') -> (env', bind':binds') -- In these functions the substitution maps InVar -> OutExpr ---------------------- -type SimpleClo = (SimpleOptEnv, InExpr) +type SimpleClo = (SimpleOptEnv, InExpr) -- Like SimplSR's ContEx data SimpleOptEnv = SOE { soe_co_opt_opts :: !OptCoercionOpts @@ -191,7 +198,8 @@ data SimpleOptEnv , soe_inl :: IdEnv SimpleClo -- ^ Deals with preInlineUnconditionally; things -- that occur exactly once and are inlined - -- without having first been simplified + -- without having first been simplified or + -- substituted, thus the domain is InBndrs , soe_subst :: Subst -- ^ Deals with cloning; includes the InScopeSet @@ -247,9 +255,10 @@ simple_opt_expr env expr go (Lit lit) = Lit lit go (Tick tickish e) = mkTick (substTickish subst tickish) (go e) go (Cast e co) = mk_cast (go e) (go_co co) - go (Let bind body) = case simple_opt_bind env bind NotTopLevel of - (env', Nothing) -> simple_opt_expr env' body - (env', Just bind) -> Let bind (simple_opt_expr env' body) + go (Let bind body) = + case simple_opt_local_bind env (exprType body) bind of + (env', Nothing) -> simple_opt_expr env' body + (env', Just bind) -> Let bind (simple_opt_expr env' body) go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) @@ -351,7 +360,7 @@ simple_app env (Tick t e) as -- However, do /not/ do this transformation for join points -- See Note [simple_app and join points] simple_app env (Let bind body) args - = case simple_opt_bind env bind NotTopLevel of + = case simple_opt_local_bind env (exprType body) bind of (env', Nothing) -> simple_app env' body args (env', Just bind') | isJoinBind bind' -> finish_app env expr' args @@ -369,29 +378,87 @@ finish_app env fun (arg:args) = finish_app env (App fun (simple_opt_clo env arg)) args ---------------------- -simple_opt_bind :: SimpleOptEnv -> InBind -> TopLevelFlag - -> (SimpleOptEnv, Maybe OutBind) -simple_opt_bind env (NonRec b r) top_level - = (env', case mb_pr of - Nothing -> Nothing - Just (b,r) -> Just (NonRec b r)) +extendInlEnv :: SimpleOptEnv -> InBndr -> SimpleClo -> SimpleOptEnv +-- Like GHC.Core.Opt.Simplify.Env.extendIdSubst +extendInlEnv env@(SOE { soe_inl = inl_env }) bndr clo + = ASSERT2( isId bndr && not (isCoVar bndr), ppr bndr ) + env { soe_inl = extendVarEnv inl_env bndr clo } + +extendInScopeEnv :: SimpleOptEnv -> [InBndr] -> SimpleOptEnv +extendInScopeEnv env@(SOE { soe_subst = Subst in_scope ids tvs cos }) bndrs + = env { soe_subst = Subst (extendInScopeSetList in_scope bndrs) ids tvs cos } + +tryJoinPointWWs :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe ([(InBndr, InExpr)], [(InBndr, InExpr)]) +tryJoinPointWWs in_scope body_ty binds + = foldMap go <$> joinPointBindings_maybe in_scope body_ty binds where - (b', r') = joinPointBinding_maybe b r `orElse` (b, r) - (env', mb_pr) = simple_bind_pair env b' Nothing (env,r') top_level + go jph = ([(join_bndr jph, join_rhs jph)], join_wrapper jph) + join_wrapper jph at JoinPointAfterMono{} -- Rare: A join point after we inline a wrapper + = [(join_wrapper_bndr jph, join_wrapper_body jph)] + join_wrapper DefinitelyJoinPoint{} -- Common: Regular join point. No wrapper + = [] + +tryJoinPointWW :: InScopeSet -> Type -> InBndr -> InExpr -> Maybe (InBndr, InExpr, [(InBndr, InExpr)]) +tryJoinPointWW in_scope body_ty b r + | Just ([(b', r')], wrappers) <- tryJoinPointWWs in_scope body_ty [(b, r)] + = ASSERT( wrappers `lengthAtMost` 1 ) + Just (b', r', wrappers) + | otherwise + = Nothing -simple_opt_bind env (Rec prs) top_level - = (env'', res_bind) +pair_to_non_rec + :: (SimpleOptEnv, Maybe (OutBndr, OutExpr)) + -> (SimpleOptEnv, Maybe OutBind) +pair_to_non_rec (env, mb_pr) = (env, uncurry NonRec <$> mb_pr) + +simple_opt_local_bind + :: SimpleOptEnv -> Type -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_local_bind env body_ty (NonRec b r) + | (b', r', wrappers) <- tryJoinPointWW (substInScope (soe_subst env) `extendInScopeSet` b) body_ty b r `orElse` (b, r, []) + -- , null wrappers || pprTrace "simple_opt_local_bind:join" (ppr b <+> ppr (idType b) <+> ppr body_ty) True + = -- pprTraceWith "simple_opt_local_bind" (\(env', mb_bind) -> ppr b <+> (case mb_bind of Nothing -> text "inlined" $$ ppr env'; Just _ -> text "not inlined")) $ + first (pre_inline_join_wrappers wrappers) + $ pair_to_non_rec + $ simple_bind_pair env b' Nothing (env,r') NotTopLevel + +simple_opt_local_bind env body_ty (Rec prs) + --- | null wrappers || pprTrace "simple_opt_local_bind:joinrec" (ppr prs <+> ppr body_ty) True + = (env3, res_bind) where - res_bind = Just (Rec (reverse rev_prs')) - prs' = joinPointBindings_maybe prs `orElse` prs - (env', bndrs') = subst_opt_bndrs env (map fst prs') - (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs') - do_pr (env, prs) ((b,r), b') + res_bind = Just (Rec (reverse rev_prs')) + (prs', wrappers) = tryJoinPointWWs (substInScope (soe_subst env)) body_ty prs `orElse` (prs, []) + (env1, bndrs') = subst_opt_bndrs env (map fst prs') + env2 = pre_inline_join_wrappers wrappers env1 + (env3, rev_prs') = foldl' simpl_pr (env2, []) (prs' `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') = (env', case mb_pr of Just pr -> pr : prs Nothing -> prs) where - (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) top_level + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) NotTopLevel + +pre_inline_join_wrappers :: [(InBndr, InExpr)] -> SimpleOptEnv -> SimpleOptEnv +pre_inline_join_wrappers binds env + = foldl' (\env (b,r) -> extendInlEnv env b (env, r)) env' binds + where + env' = extendInScopeEnv env (map fst binds) + +simple_opt_bind :: SimpleOptEnv -> InBind -> (SimpleOptEnv, Maybe OutBind) +simple_opt_bind env (NonRec b r) + = pair_to_non_rec (simple_bind_pair env b Nothing (env,r) TopLevel) + +simple_opt_bind env (Rec prs) + = (env'', res_bind) + where + res_bind = Just (Rec (reverse rev_prs')) + (env', bndrs') = subst_opt_bndrs env (map fst prs) + (env'', rev_prs') = foldl' simpl_pr (env', []) (prs `zip` bndrs') + simpl_pr (env, prs) ((b,r), b') + = (env', case mb_pr of + Just pr -> pr : prs + Nothing -> prs) + where + (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) TopLevel ---------------------- simple_bind_pair :: SimpleOptEnv @@ -796,39 +863,260 @@ A more common case is when and again its arity increases (#15517) -} - --- | Returns Just (bndr,rhs) if the binding is a join point: --- If it's a JoinId, just return it +-- | Indicates that a binding can be transformed into a join point. +data JoinPointHood + = DefinitelyJoinPoint -- ^ A join point by nature + { join_bndr :: !InBndr + , join_rhs :: !InExpr } + | JoinPointAfterMono + -- ^ A join point after we have instantiated the forall binders occuring in + -- the result type. See Note [Join point worker/wrapper]. + { join_bndr :: !InBndr + , join_rhs :: !InExpr + , join_wrapper_bndr :: !InBndr + -- ^ the bndr of a wrapper that needs to be inlined unconditionally + , join_wrapper_body :: !InExpr } + +-- | An element of the result list of 'matchJoinResTy'. +-- Corresponds to a join binder of what is going to be the new join point. +-- See Note [Join point worker/wrapper]. +data JoinWorkerBinder + = InstBinder !Type + -- ^ A binder that could be instantiated to the given type by matching against + -- the res ty. The corresponding binder will be dropped for the new join point + | SubstBinder !TyCoBinder + -- ^ A join binder that was not instantiated by matching against the res ty. + -- But since other join binders might have been instantiated, the binder's + -- type might have changed. + +instance Outputable JoinWorkerBinder where + ppr (InstBinder ty) = text "Inst" <+> ppr ty + ppr (SubstBinder bndr) = text "Subst" <+> ppr bndr + +isSubstBinder :: JoinWorkerBinder -> Bool +isSubstBinder SubstBinder{} = True +isSubstBinder _ = False + +-- | Returns Just jph if the binding is a join point: +-- If it's a JoinId, just return @DefinitelyJoinPoint bndr rhs at . -- If it's not yet a JoinId but is always tail-called, -- make it into a JoinId and return it. -- In the latter case, eta-expand the RHS if necessary, to make the --- lambdas explicit, as is required for join points +-- lambdas explicit, as is required for join points. +-- If the join point is not result type polymorphic, return +-- @DefinitelyJoinPoint bndr rhs at . +-- If the join point is result type polymorphic, monomorphise it first, +-- returning @JoinPointAfterMono bndr rhs worker_bndr worker_rhs at . +-- Call sites then have to unconditionally inline the @bndr@/@rhs at . +-- See Note [Join point worker/wrapper]. -- -- Precondition: the InBndr has been occurrence-analysed, -- so its OccInfo is valid -joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr) -joinPointBinding_maybe bndr rhs - | not (isId bndr) - = Nothing - - | isJoinId bndr - = Just (bndr, rhs) +joinPointBindings_maybe :: InScopeSet -> Type -> [(InBndr, InExpr)] -> Maybe [JoinPointHood] +joinPointBindings_maybe in_scope body_type binds + = snd <$> mapAccumLM go (extendInScopeSetList in_scope (map fst binds)) binds + where + go :: InScopeSet -> (InBndr, InExpr) -> Maybe (InScopeSet, JoinPointHood) + go in_scope (bndr, rhs) + | not (isId bndr) + = Nothing + + | isJoinId bndr + = Just (in_scope, DefinitelyJoinPoint bndr rhs) + + | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) + , not (exprIsTrivial rhs) + , (lam_bndrs, rhs') <- etaExpandToJoinPoint join_arity rhs + , let eta_rhs' = mkLams lam_bndrs rhs' + , let inst_tys = matchJoinResTy join_arity (idType bndr) body_type + , let new_join_arity = count isSubstBinder inst_tys + , let no_mono = new_join_arity == join_arity + , let worker_body = mk_worker_body lam_bndrs inst_tys eta_rhs' + -- we need an in-scope set as if the worker was defined inside the RHS of the wrapper (as is the case with SAT) + , let in_scope' = extendInScopeSetList in_scope lam_bndrs + , let new_bndr = uniqAway in_scope' bndr -- only used in else branch + `setIdType` exprType worker_body + , let wrapper_body = mk_wrapper_body new_bndr lam_bndrs inst_tys + , let wrapper_bndr = bndr + -- , no_mono || pprTrace "always tail called:" (vcat [ppr in_scope', ppr bndr, ppr (idType bndr), ppr body_type, ppr rhs, ppr new_bndr, ppr (exprType worker_body), ppr join_arity, ppr inst_tys, ppr new_bndr, ppr wrapper_body, ppr worker_body]) True + = Just $! if no_mono + then ( in_scope + , DefinitelyJoinPoint + { join_bndr = adjust_id_info bndr lam_bndrs join_arity + , join_rhs = eta_rhs' } ) + else ( extendInScopeSet in_scope new_bndr + , JoinPointAfterMono + { join_bndr = adjust_id_info new_bndr lam_bndrs new_join_arity + , join_rhs = worker_body + , join_wrapper_bndr = wrapper_bndr + , join_wrapper_body = wrapper_body } ) - | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) - , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs - , let str_sig = idStrictness bndr - str_arity = count isId bndrs -- Strictness demands are for Ids only - join_bndr = bndr `asJoinId` join_arity - `setIdStrictness` etaConvertStrictSig str_arity str_sig - = Just (join_bndr, mkLams bndrs body) + | otherwise + = Nothing + + adjust_id_info :: InBndr -> [InBndr] -> JoinArity -> InBndr + adjust_id_info bndr lam_bndrs join_arity = zapStableUnfolding $ -- TODO: Discuss! Type errors otherwise. + let str_sig = idStrictness bndr + str_arity = count isId lam_bndrs -- Strictness demands are for Ids only + in bndr `asJoinId` join_arity + `setIdStrictness` etaConvertStrictSig str_arity str_sig + + mk_wrapper_body :: InBndr -> [InBndr] -> [JoinWorkerBinder] -> InExpr + -- See Note [Join point worker/wrapper]. + mk_wrapper_body new_bndr lam_bndrs inst_tys + = ASSERT( lam_bndrs `equalLength` inst_tys ) + -- pprTraceWith "mk_wrapper_body" (\e -> ppr lam_bndrs $$ ppr inst_tys $$ ppr e) $ + go (Var new_bndr) $ zipEqual "mk_wrapper_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder{}):prs) -- non-instantiated parameter + | isId lb -- value paramater xs + = Lam lb (go (App e (Var lb)) prs) + | otherwise -- type paramater @b + = Lam lb (go (App e (Type (mkTyVarTy lb))) prs) + go e ((lb,InstBinder{}):prs) -- instantiated parameter, @a or @c + = ASSERT( isTyVar lb ) + Lam lb (go e prs) + + mk_worker_body :: [InBndr] -> [JoinWorkerBinder] -> InExpr -> InExpr + -- See Note [Join point worker/wrapper]. + mk_worker_body lam_bndrs inst_tys rhs + = -- pprTraceWith "mk_worker_body" (\e -> ppr e) $ + go rhs $ zipEqual "mk_worker_body" lam_bndrs inst_tys + where + go e [] = e + go e ((lb,SubstBinder bndr):prs) -- non-instantiated parameter + | Anon _ (Scaled _ ty) <- bndr -- value paramater xs + , let lb' = lb `setIdType` ty + = Lam lb' (go (App e (Var lb')) prs) + | Named (binderVar -> tcv) <- bndr -- type paramater @b + = Lam tcv (go (App e (Type (mkTyVarTy tcv))) prs) + go e ((_ ,InstBinder ty):prs) -- instantiated paramater, @a or @c + = go (App e (Type ty)) prs + +-- | Figures out how to monomorphise the result type of a join point. +-- +-- @matchJoinResTy ja join_ty body_ty@ computes the result type of @join_ty@ by +-- skipping @ja@ binders and then matches it against @body_ty at . +-- If a forall binder @a@ is mentioned in the resulting substitution @subst@, +-- the corresponding entry in the returned list is @InstBinder (subst a)@. +-- See Note [Join point worker/wrapper]. +-- +-- Postcondition: The returned list has length @ja at . +matchJoinResTy + :: JoinArity -- ^ Number of binders to skip + -> Type -- ^ Type of the join point + -> Type -- ^ Type of the join body + -> [JoinWorkerBinder] -- ^ An entry for each join binder, + -- InstBinder ty <=> instantiates corresponding forall to ty +matchJoinResTy orig_ar orig_ty body_ty = snd (go init_in_scope orig_ar orig_ty) + where + init_in_scope = mkInScopeSet $ tyCoVarsOfType body_ty `unionVarSet` tyCoVarsOfType orig_ty - | otherwise - = Nothing + go :: InScopeSet -> Int -> Type -> (TCvSubst, [JoinWorkerBinder]) + go in_scope 0 res_ty = (TCvSubst in_scope tvs cvs, []) + where + TCvSubst _ tvs cvs = expectJust "matchJoinResTy" $ tcMatchTy res_ty body_ty + + go in_scope n ty + | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty + = case arg_bndr of + Anon f (Scaled m ty) + | (subst, inst_tys) <- go in_scope (n-1) res_ty + -> (subst, SubstBinder (Anon f (Scaled m (Type.substTy subst ty))):inst_tys) + Named (Bndr tcv vis) + | isTyVar tcv', Just ty <- lookupTyVar subst tcv' + -> (subst', InstBinder ty: inst_tys) + | otherwise + -> (subst', SubstBinder (Named (Bndr subst_tcv vis)) : inst_tys) + where + tcv' = uniqAway in_scope tcv + in_scope' = extendInScopeSet in_scope tcv' + (subst, inst_tys) = go in_scope' (n-1) res_ty + subst' = delTCvSubst subst tcv' + subst_tcv = tcv' `setVarType` Type.substTy subst' (varType tcv') -joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)] -joinPointBindings_maybe bndrs - = mapM (uncurry joinPointBinding_maybe) bndrs + go _ _ _ = pprPanic "matchJoinResTy" (ppr orig_ar <+> ppr orig_ty) +{- Note [Join point worker/wrapper] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some let bindings that are 'AlwaysTailCalled' still need a bit of work to become +a join point. Here's an example: + + let f :: forall a b. [a] -> forall c. b -> Maybe c -> [(a,c)] + f = + in ( :: [(Bool, Char)]) + +Suppose @f@ is 'AlwaysTailCalled' in . Its result type is polymorphic, +which is exactly the situation as in +Historic Note [The polymorphism rule of join points]. +That Note also explains why we can't just turn @f@ into join point untouched. + +So we need a transformation that monomorphises @f@ for its result type. Since we +have available the type of (the soon to be join-) , we can match @[(a,c)]@ +against @[(Bool, Char)]@ to get a substitution @[a ↦ Bool, c ↦ Char]@. We then +apply this substitution to the tyco binders in the type of @f@, as we ascend +from the result type: + + * @Maybe c@ is substituted to @Maybe Char@ ('SubstBinder') + * @b@ is substituted to @b@ (unchanged, likewise 'SubstBinder') + * @forall c@ is in the domain of the substitution and thus will be + instantiated ('InstBinder') + * @[a]@ is substituted to @[Bool]@ ('SubstBinder') + * @forall b@ is substituted (note that in general its kind might mention @a@) + to @forall b@ ('SubstBinder') + * @forall a@ is in the domain of the substitution and thus will be + instantiated ('InstBinder') + +Figuring out this list of 'JoinWorkerBinder's (which is the +'SubstBinder'/'InstBinder') is the job of 'matchJoinResTy'. +In the simple, non-polymorphic case, it returns a list of 'SubstBinder's, one +for each join binder. Otherwise, there is at least one 'InstBinder' that +indicates monorphisation of a polymorphic join result type. + +The challenge is in rewriting all call sites of @f@ to match its new type, +dropping the instantiated type arguments. A typical use case for the +worker/wrapper transformation. Thus, we make @f@ a wrapper that rewrites to the +new worker join point f': + + let f :: forall a b. [a] -> forall c. b -> Maybe c -> [(a,c)] + f = \@a @b (xs :: [a]) @c b (mc :: Maybe c) -> f' @b xs b mc + f' :: forall b. [Bool] -> b -> Maybe Char -> [(Bool, Char)] + f' = \@b (xs :: [Bool]) b mb -> @Bool @b xs @Char b mb + in ( :: [(Bool, Char)]) + +Take note that @f@'s type did not change, but its new RHS is now actually +ill-typed. This doesn't matter as long as we manage to inline the wrapper +unconditionally at its call sites in , where the arguments for @a@ and @c@ +will always be @Bool@ and @Char at . + +The join point worker @f'@ similarly instantiates @a@ and @c@ to @Bool@ and + at Char@. Its result type is monomorphic and it can be made into a join point. + +The worker/wrapper split is carried out by 'joinPointBindings_maybe', but only +if there are any 'InstBinder's at all (In which case it returns the result + at JoinPointAfterMono@). +Equipped with the 'matchJoinResTy' result (InstBinder = I, SubstBinder = S) + + [I Bool, S (b::*), S (_::[Bool]), I Char, S (_::b), S (_::Maybe Char)] + +It builds the wrapper body of @f@ by applying the new worker binder @f'@ to + + * Nothing if the corresponding 'JoinWorkerBinder' is @I _@ + * @b@ if the corresponding 'JoinWorkerBinder' is @S _@ and @b@ is the old + lambda binder + +It builds the worker body of @f'@ by applying the to + + * @ty@ if the corresponding 'JoinWorkerBinder' is @I ty@ + * @tv@ if the corresponding 'JoinWorkerBinder' is @S (tv::..)@ (Named binder) + * @b@ if the corresponding 'JoinWorkerBinder' is @S (_::ty)@ (Anon binder) + and @b@ is the old lambda binder with its type updated to @ty at . + +The result of @joinPointBindings_maybe@ is ultimately exported via @tryJoinWW@ +and is used in the simple optimiser as well as the Simplifier, which both +inline the join point wrapper unconditionally (if present). +-} {- ********************************************************************* * * @@ -1342,5 +1630,3 @@ exprIsLambda_maybe (in_scope_set, id_unf) e exprIsLambda_maybe _ _e = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e]) Nothing - - ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Core.TyCo.Subst getTvSubstEnv, getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs, isInScope, notElemTCvSubst, - setTvSubstEnv, setCvSubstEnv, zapTCvSubst, + setTvSubstEnv, setCvSubstEnv, zapTCvSubst, delTCvSubst, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendTCvSubstWithClone, extendCvSubst, extendCvSubstWithClone, @@ -308,6 +308,23 @@ setCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv zapTCvSubst :: TCvSubst -> TCvSubst zapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv +delTCvSubst :: TCvSubst -> Var -> TCvSubst +delTCvSubst subst v + | isTyVar v + = delTvSubst subst v + | isCoVar v + = delCvSubst subst v + | otherwise + = pprPanic "delTCvSubst" (ppr v) + +delTvSubst :: TCvSubst -> TyVar -> TCvSubst +delTvSubst (TCvSubst in_scope tenv cenv) tv + = TCvSubst in_scope (delVarEnv tenv tv) cenv + +delCvSubst :: TCvSubst -> CoVar -> TCvSubst +delCvSubst (TCvSubst in_scope tenv cenv) cv + = TCvSubst in_scope tenv (delVarEnv cenv cv) + extendTCvInScope :: TCvSubst -> Var -> TCvSubst extendTCvInScope (TCvSubst in_scope tenv cenv) var = TCvSubst (extendInScopeSet in_scope var) tenv cenv ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -193,7 +193,7 @@ module GHC.Core.Type ( zipTCvSubst, notElemTCvSubst, getTvSubstEnv, setTvSubstEnv, - zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs, + zapTCvSubst, delTCvSubst, getTCvInScope, getTCvSubstRangeFVs, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubst, extendCvSubst, extendTvSubst, extendTvSubstBinderAndInScope, ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -276,7 +276,7 @@ applyTypeToArgs e op_ty args go op_ty (Coercion co : args) = go_ty_args op_ty [mkCoercionTy co] args go op_ty (_ : args) | Just (_, _, res_ty) <- splitFunTy_maybe op_ty = go res_ty args - go _ args = pprPanic "applyTypeToArgs" (panic_msg args) + go op_ty args = pprPanic "applyTypeToArgs" (panic_msg op_ty args) -- go_ty_args: accumulate type arguments so we can -- instantiate all at once with piResultTys @@ -287,8 +287,9 @@ applyTypeToArgs e op_ty args go_ty_args op_ty rev_tys args = go (piResultTys op_ty (reverse rev_tys)) args - panic_msg as = vcat [ text "Expression:" <+> pprCoreExpr e + panic_msg ot as = vcat [ text "Expression:" <+> pprCoreExpr e , text "Type:" <+> ppr op_ty + , text "Type':" <+> ppr ot , text "Args:" <+> ppr args , text "Args':" <+> ppr as ] @@ -2622,4 +2623,3 @@ isUnsafeEqualityProof e = idName v == unsafeEqualityProofName | otherwise = False - ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -15,6 +15,7 @@ module GHC.Driver.Ppr , pprTraceWithFlags , pprTraceM , pprTraceDebug + , pprTraceWith , pprTraceIt , pprSTrace , pprTraceException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66ec7c65736c7826f8488e104a9fbf860e7d3810 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66ec7c65736c7826f8488e104a9fbf860e7d3810 You're receiving 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 23 12:32:25 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 08:32:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18371 Message-ID: <5f6b4059227b0_80b3f84961ee31c13932344@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18371 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18371 You're receiving 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 23 12:42:48 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 08:42:48 -0400 Subject: [Git][ghc/ghc][wip/T18371] Add a regression test for #18609 Message-ID: <5f6b42c85cfef_80b3f8411460e9013937870@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18371 at Glasgow Haskell Compiler / GHC Commits: d568ec58 by Sebastian Graf at 2020-09-23T14:41:55+02:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 3 changed files: - + testsuite/tests/pmcheck/should_compile/T18609.hs - + testsuite/tests/pmcheck/should_compile/T18609.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== testsuite/tests/pmcheck/should_compile/T18609.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns, GADTs, DataKinds, KindSignatures, EmptyCase #-} + +-- | All examples from https://arxiv.org/abs/1702.02281 +module GarrigueLeNormand where + +import Data.Kind + +data N = Z | S N + +data Plus :: N -> N -> N -> Type where + PlusO :: Plus Z a a + PlusS :: !(Plus a b c) -> Plus (S a) b (S c) + +data SMaybe a = SJust !a | SNothing + +trivial :: SMaybe (Plus (S Z) Z Z) -> () +trivial SNothing = () + +trivial2 :: Plus (S Z) Z Z -> () +trivial2 x = case x of {} + +easy :: SMaybe (Plus Z (S Z) Z) -> () +easy SNothing = () + +easy2 :: Plus Z (S Z) Z -> () +easy2 x = case x of {} + +harder :: SMaybe (Plus (S Z) (S Z) (S Z)) -> () +harder SNothing = () + +harder2 :: Plus (S Z) (S Z) (S Z) -> () +harder2 x = case x of {} + +invZero :: Plus a b c -> Plus c d Z -> () +invZero !_ !_ | False = () +invZero PlusO PlusO = () + +data T a where + A :: T Int + B :: T Bool + C :: T Char + D :: T Float + +data U a b c d where + U :: U Int Int Int Int + +f :: T a -> T b -> T c -> T d + -> U a b c d + -> () +f !_ !_ !_ !_ !_ | False = () +f A A A A U = () + +g :: T a -> T b -> T c -> T d + -> T e -> T f -> T g -> T h + -> U a b c d + -> U e f g h + -> () +g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = () +g A A A A A A A A U U = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.stderr ===================================== @@ -0,0 +1,13 @@ + +T18609.hs:36:25: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘invZero’: invZero !_ !_ | False = ... + +T18609.hs:51:20: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !_ !_ !_ !_ !_ | False = ... + +T18609.hs:59:35: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: + g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -150,6 +150,8 @@ 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('T18609', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d568ec5857a649953992006d5b8f3be58e15ba19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d568ec5857a649953992006d5b8f3be58e15ba19 You're receiving 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 23 12:50:15 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 08:50:15 -0400 Subject: [Git][ghc/ghc][wip/T18371] Accept new test output for #17218 Message-ID: <5f6b44877d9bb_80b3f837b63e5f0139433aa@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18371 at Glasgow Haskell Compiler / GHC Commits: 5ab474b3 by Sebastian Graf at 2020-09-23T14:49:24+02:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 2 changed files: - testsuite/tests/pmcheck/should_compile/T17218.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== testsuite/tests/pmcheck/should_compile/T17218.stderr ===================================== @@ -1,6 +1,4 @@ T17218.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In an equation for ‘f’: - Patterns not matched: - C + In an equation for ‘f’: Patterns not matched: P ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -96,7 +96,7 @@ test('T17215', expect_broken(17215), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17216', expect_broken(17216), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17218', expect_broken(17218), compile, +test('T17218', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17219', expect_broken(17219), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ab474b3fada3030bee7fc77026b90e234826658 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ab474b3fada3030bee7fc77026b90e234826658 You're receiving 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 23 13:38:45 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Wed, 23 Sep 2020 09:38:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/print_big_ret_stack_closures Message-ID: <5f6b4fe5d3704_80b3f8468d41148139557b3@gitlab.haskell.org.mail> Sven Tennie pushed new branch wip/print_big_ret_stack_closures at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/print_big_ret_stack_closures You're receiving 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 23 14:59:39 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 23 Sep 2020 10:59:39 -0400 Subject: [Git][ghc/ghc][wip/T16762] More wibbles --- getting there Message-ID: <5f6b62db8da41_80b3f848cfe5588139717f7@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 4186227e by Simon Peyton Jones at 2020-09-23T15:58:31+01:00 More wibbles --- getting there - - - - - 9 changed files: - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Unify.hs - + testsuite/tests/polykinds/T16762.hs - + testsuite/tests/polykinds/T16762a.hs - testsuite/tests/polykinds/all.T Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -31,9 +31,10 @@ module GHC.Tc.Gen.HsType ( bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol, tcOuterSigTKBndrs, scopedSortOuter, + tcExplicitTKBndrs, + bindOuterSigTKBndrs_Tv, bindOuterFamEqnTKBndrs_Q_Skol, bindOuterFamEqnTKBndrs_Q_Tv, - bindOuterSigTKBndrs_Tv, bindOuterSigTKBndrs_Skol, -- Type checking type and class decls, and instances thereof bindTyClTyVars, tcFamTyPats, @@ -124,7 +125,6 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Maybe import GHC.Data.Bag( unitBag ) -import Data.Bitraversable import Data.List ( find ) import Control.Monad @@ -381,15 +381,11 @@ kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () -- 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 - sig_ty@(L _ (HsSig { sig_bndrs = outer_bndrs, sig_body = hs_ty })) + sig_ty@(L _ (HsSig { sig_bndrs = hs_outer_bndrs, sig_body = hs_ty })) = addSigCtxt (funsSigCtxt names) sig_ty $ - do { (tc_lvl, wanted, (imp_or_exp_tkvs, _)) - <- pushLevelAndSolveEqualitiesX "kcClassSigType" $ - bindOuterSigTKBndrs_Skol outer_bndrs $ + do { _ <- tcOuterSigTKBndrs TypeLevel skol_info hs_outer_bndrs $ tcLHsType hs_ty liftedTypeKind - - ; let spec_tkvs = either id binderVars imp_or_exp_tkvs - ; emitResidualTvConstraint skol_info spec_tkvs tc_lvl wanted } + ; return () } tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type -- Does not do validity checking @@ -445,30 +441,13 @@ tc_hs_sig_type :: SkolemInfo -> LHsSigType GhcRn -- This will never emit constraints, as it uses solveEqualities internally. -- No validity checking or zonking -- Returns also an implication for the unsolved constraints -tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs +tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = hs_outer_bndrs , sig_body = hs_ty })) ctxt_kind = setSrcSpan loc $ - do { -- When there are /explicit/ user-written binders, e.g. - -- f :: forall a {k} (b::k). blah - -- treat it exactly like HsForAllTy; including its own, - -- individual implication constraint, so we get proper - -- telescope checking. - -- NB1: Do not be tempted to combine this implication constraint - -- with the one from kind generalisation. That messes up the - -- telescope error message, by mixing the inferred kind - -- quantifiers with the explicit ones. See GHC.Tc.Types.Constraint - -- Note [Checking telescopes], in the "don't mix up" bullet. - -- NB2: There are no implicit binders (the forall-or-nothing rule), - -- hence implicit_bndrs = [] - -- - -- When there are only /implicit/ binders, added by the renamer, e.g. - -- f :: a -> t a -> t a - -- then bring those implicit binders into scope here. - - ; (tc_lvl, wanted, (outer_bndrs, ty)) + do { (tc_lvl, wanted, (outer_bndrs, ty)) <- pushLevelAndSolveEqualitiesX "tc_hs_sig_type" $ -- See Note [Failure in local type signatures] - tcOuterSigTKBndrs outer_bndrs $ + tcOuterSigTKBndrs TypeLevel skol_info hs_outer_bndrs $ do { kind <- newExpectedKind ctxt_kind ; tcLHsType hs_ty kind } -- Any remaining variables (unsolved in the solveEqualities) @@ -482,8 +461,7 @@ tc_hs_sig_type skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- Build an implication for any as-yet-unsolved kind equalities -- See Note [Skolem escape in type signatures] - ; let skol_tvs = kvs ++ binderVars outer_tv_bndrs - ; implic <- buildTvImplication skol_info skol_tvs tc_lvl wanted + ; implic <- buildTvImplication skol_info kvs tc_lvl wanted ; return (implic, mkInfForAllTys kvs ty1) } @@ -520,45 +498,45 @@ top level of a signature. -- Does validity checking and zonking. tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) -tcStandaloneKindSig (L _ kisig) = case kisig of - StandaloneKindSig _ (L _ name) ksig -> - let ctxt = StandaloneKindSigCtxt name in - addSigCtxt ctxt ksig $ - do { let mode = mkMode KindLevel - ; kind <- tc_top_lhs_type mode ksig (expectedKindInCtxt ctxt) +tcStandaloneKindSig (L _ (StandaloneKindSig _ (L _ name) ksig)) + = addSigCtxt ctxt ksig $ + do { kind <- tc_top_lhs_type KindLevel ksig (expectedKindInCtxt ctxt) ; checkValidType ctxt kind ; return (name, kind) } - + where + ctxt = StandaloneKindSigCtxt name tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type tcTopLHsType lsig_ty ctxt_kind - = tc_top_lhs_type (mkMode TypeLevel) lsig_ty ctxt_kind + = tc_top_lhs_type TypeLevel lsig_ty ctxt_kind -tc_top_lhs_type :: TcTyMode -> LHsSigType GhcRn -> ContextKind -> TcM Type +tc_top_lhs_type :: TypeOrKind -> LHsSigType GhcRn -> ContextKind -> TcM Type -- tc_top_lhs_type is used for kind-checking top-level LHsSigTypes where -- we want to fully solve /all/ equalities, and report errors -- Does zonking, but not validity checking because it's used -- for things (like deriving and instances) that aren't -- ordinary types -- Used for both types and kinds -tc_top_lhs_type mode (L loc sig_ty@(HsSig { sig_bndrs = outer_bndrs - , sig_body = body })) ctxt_kind +tc_top_lhs_type tyki (L loc sig_ty@(HsSig { sig_bndrs = hs_outer_bndrs + , sig_body = body })) ctxt_kind = setSrcSpan loc $ do { traceTc "tc_top_lhs_type {" (ppr sig_ty) - ; (tclvl, wanted, (imp_or_exp_tkvs, ty)) + ; let skol_info = InstSkol -- Why? + ; (tclvl, wanted, (outer_bndrs, ty)) <- pushLevelAndSolveEqualitiesX "tc_top_lhs_type" $ - bindOuterSigTKBndrs_Skol_M mode outer_bndrs $ + tcOuterSigTKBndrs tyki skol_info hs_outer_bndrs $ do { kind <- newExpectedKind ctxt_kind - ; tc_lhs_type mode body kind } + ; tc_lhs_type (mkMode tyki) body kind } + + ; outer_tv_bndrs <- scopedSortOuter outer_bndrs + ; let ty1 = mkInvisForAllTys outer_tv_bndrs ty - ; imp_or_exp_tkvs <- bitraverse zonkAndScopedSort pure imp_or_exp_tkvs - ; reportUnsolvedEqualities InstSkol (either id binderVars imp_or_exp_tkvs) tclvl wanted - -- Yuk to all this either stuff. TODO - ; let ty1 = either mkSpecForAllTys mkInvisForAllTys imp_or_exp_tkvs ty ; kvs <- kindGeneralizeAll ty1 -- "All" because it's a top-level type + ; reportUnsolvedEqualities skol_info kvs tclvl wanted + ; final_ty <- zonkTcTypeToType (mkInfForAllTys kvs ty1) ; traceTc "tc_top_lhs_type }" (vcat [ppr sig_ty, ppr final_ty]) - ; return final_ty} + ; return final_ty } ----------------- tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], Class, [Type], [Kind]) @@ -1082,12 +1060,11 @@ tc_hs_type mode (HsOpTy _ ty1 (L _ op) ty2) exp_kind --------- Foralls tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind - = do { (tv_bndrs, ty') - <- tcTKTelescope mode tele $ + = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $ + tc_lhs_type mode ty exp_kind -- Pass on the mode from the type, to any wildcards -- in kind signatures on the forall'd variables -- e.g. f :: _ -> Int -> forall (a :: _). blah - tc_lhs_type mode ty exp_kind -- Why exp_kind? See Note [Body kind of HsForAllTy] -- Do not kind-generalise here! See Note [Kind generalisation] @@ -2990,57 +2967,7 @@ variable. So that's what we do. -} -------------------------------------- --- Implicit binders --------------------------------------- - -bindImplicitTKBndrs_Skol, bindImplicitTKBndrs_Tv, - bindImplicitTKBndrs_Q_Skol, bindImplicitTKBndrs_Q_Tv - :: [Name] -> TcM a -> TcM ([TcTyVar], a) -bindImplicitTKBndrs_Q_Skol = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedSkolemTyVar) -bindImplicitTKBndrs_Q_Tv = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedTyVarTyVar) -bindImplicitTKBndrs_Skol = bindImplicitTKBndrsX newFlexiKindedSkolemTyVar -bindImplicitTKBndrs_Tv = bindImplicitTKBndrsX cloneFlexiKindedTyVarTyVar - -- newFlexiKinded... see Note [Non-cloning for tyvar binders] - -- cloneFlexiKindedTyVarTyVar: see Note [Cloning for tyvar binders] - -bindImplicitTKBndrsX - :: (Name -> TcM TcTyVar) -- new_tv function - -> [Name] - -> TcM a - -> TcM ([TcTyVar], a) -- Returned [TcTyVar] are in 1-1 correspondence - -- with the passed in [Name] -bindImplicitTKBndrsX new_tv tv_names thing_inside - = do { tkvs <- mapM new_tv tv_names - ; traceTc "bindImplicitTKBndrs" (ppr tv_names $$ ppr tkvs) - ; res <- tcExtendNameTyVarEnv (tv_names `zip` tkvs) - thing_inside - ; return (tkvs, res) } - -newImplicitTyVarQ :: (Name -> TcM TcTyVar) -> Name -> TcM TcTyVar --- Behave like new_tv, except that if the tyvar is in scope, use it -newImplicitTyVarQ new_tv name - = do { mb_tv <- tcLookupLcl_maybe name - ; case mb_tv of - Just (ATyVar _ tv) -> return tv - _ -> new_tv name } - -newFlexiKindedTyVar :: (Name -> Kind -> TcM TyVar) -> Name -> TcM TyVar -newFlexiKindedTyVar new_tv name - = do { kind <- newMetaKindVar - ; new_tv name kind } - -newFlexiKindedSkolemTyVar :: Name -> TcM TyVar -newFlexiKindedSkolemTyVar = newFlexiKindedTyVar newSkolemTyVar - -newFlexiKindedTyVarTyVar :: Name -> TcM TyVar -newFlexiKindedTyVarTyVar = newFlexiKindedTyVar newTyVarTyVar - -cloneFlexiKindedTyVarTyVar :: Name -> TcM TyVar -cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar - -- See Note [Cloning for tyvar binders] - --------------------------------------- --- Explicit binders +-- HsForAllTelescope -------------------------------------- tcTKTelescope :: TcTyMode @@ -3049,20 +2976,53 @@ tcTKTelescope :: TcTyMode -> TcM ([TcTyVarBinder], a) tcTKTelescope mode tele thing_inside = case tele of HsForAllVis { hsf_vis_bndrs = bndrs } - -> do { (req_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside + -> do { (req_tv_bndrs, thing) <- tcExplicitTKBndrs_M mode bndrs thing_inside -- req_tv_bndrs :: [VarBndr TyVar ()], -- but we want [VarBndr TyVar ArgFlag] ; return (tyVarReqToBinders req_tv_bndrs, thing) } HsForAllInvis { hsf_invis_bndrs = bndrs } - -> do { (inv_tv_bndrs, thing) <- tcExplicitTKBndrs mode bndrs thing_inside + -> do { (inv_tv_bndrs, thing) <- tcExplicitTKBndrs_M mode bndrs thing_inside -- inv_tv_bndrs :: [VarBndr TyVar Specificity], -- but we want [VarBndr TyVar ArgFlag] ; return (tyVarSpecToBinders inv_tv_bndrs, thing) } -scopedSortOuter :: OuterTyVarBndrs [TcTyVar] [TcInvisTVBinder] - -> TcM [TcInvisTVBinder] +-------------------------------------- +-- OuterTyVarBndrs +-------------------------------------- + +type OuterTVBs = OuterTyVarBndrs + [TcTyVar] -- Implicit + [TcInvisTVBinder] -- Explicit, with Specificity + -- OuterTVBs is what we get afeter typechecking HsOuterSigTyVarBndrs + -- with tcOuterSigTKBndrs + +--------------- +fmapOuterTVBs :: (hs_imp -> TcM a -> TcM (imp, a)) -- Deal with implicit binders + -> (hs_exp -> TcM a -> TcM (exp, a)) -- Deal with explicit binders + -> OuterTyVarBndrs hs_imp hs_exp + -> TcM a + -> TcM (OuterTyVarBndrs imp exp, a) +fmapOuterTVBs do_implicit do_explicit outer_bndrs thing_inside + = case outer_bndrs of + OuterImplicit imp -> do { (imp, thing) <- do_implicit imp thing_inside + ; return (OuterImplicit imp, thing) } + OuterExplicit exp -> do { (exp, thing) <- do_explicit exp thing_inside + ; return (OuterExplicit exp, thing) } + +flatMapOuterTVBs :: (hs_imp -> TcM a -> TcM (res, a)) -- Deal with implicit binders + -> (hs_exp -> TcM a -> TcM (res, a)) -- Deal with explicit binders + -> OuterTyVarBndrs hs_imp hs_exp + -> TcM a + -> TcM (res, a) +flatMapOuterTVBs do_implicit do_explicit outer_bndrs thing_inside + = case outer_bndrs of + OuterImplicit imp -> do_implicit imp thing_inside + OuterExplicit exp -> do_explicit exp thing_inside + +--------------- +scopedSortOuter :: OuterTVBs -> TcM [TcInvisTVBinder] -- Sort any /implicit/ binders into dependency order --- (zonking first so we can see that ordre +-- (zonking first so we can see the dependencies) -- /Explicit/ ones are already in the right order scopedSortOuter (OuterImplicit imp_tvs) = do { imp_tvs <- zonkAndScopedSort imp_tvs @@ -3071,44 +3031,99 @@ scopedSortOuter (OuterExplicit exp_tvs) = -- No need to dependency-sort (or zonk) explicit quantifiers return exp_tvs -tcOuterSigTKBndrs - :: HsOuterSigTyVarBndrs GhcRn - -> TcM a - -> TcM ( OuterTyVarBndrs [TcTyVar] -- Implicit - [TcInvisTVBinder] -- Explicit, with Specificity - , a) -tcOuterSigTKBndrs (OuterImplicit implicit_nms) thing_inside - = -- Implicit: just bind the variables; no push levels, no capturing constraints - do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_nms thing_inside - ; return (OuterImplicit imp_tvs, thing) } -tcOuterSigTKBndrs (OuterExplicit hs_bndrs) thing_inside - = -- Explicit: push level, capture constraints, make implication - do { (bndrs, thing) <- tcExplicitTKBndrs (mkMode TypeLevel) hs_bndrs thing_inside - ; return (OuterExplicit bndrs, thing) } +--------------- +bindOuterSigTKBndrs_Tv :: HsOuterSigTyVarBndrs GhcRn -> TcM a -> TcM (OuterTVBs, a) +bindOuterSigTKBndrs_Tv = bindOuterSigTKBndrs_Tv_M (mkMode TypeLevel) + +bindOuterSigTKBndrs_Tv_M :: TcTyMode + -> HsOuterSigTyVarBndrs GhcRn + -> TcM a -> TcM (OuterTVBs, a) +-- Do not push level; do not make implication constraint; use Tvs +-- Two major clients of this "bind-only" path are: +-- Note [Kind-checking for GADTs] in TyCl +-- Note [Checking partial type signatures] +bindOuterSigTKBndrs_Tv_M mode + = fmapOuterTVBs bindImplicitTKBndrs_Tv (bindExplicitTKBndrs_Tv_M mode) + +-- TODO RGS: Which of these do we actually need? + +-- TODO RGS: Docs(?) +-- TODO RGS: Is the return type correct? +-- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Tv? +bindOuterFamEqnTKBndrs_Q_Skol :: ContextKind + -> HsOuterFamEqnTyVarBndrs GhcRn + -> TcM a + -> TcM ([TcTyVar], a) +bindOuterFamEqnTKBndrs_Q_Skol ctxt_kind + = flatMapOuterTVBs (bindImplicitTKBndrs_Q_Skol) + (bindExplicitTKBndrs_Q_Skol ctxt_kind) + +-- TODO RGS: Docs(?) +-- TODO RGS: Is the return type correct? +-- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Tv? +bindOuterFamEqnTKBndrs_Q_Tv :: ContextKind + -> HsOuterFamEqnTyVarBndrs GhcRn + -> TcM a + -> TcM ([TcTyVar], a) +bindOuterFamEqnTKBndrs_Q_Tv ctxt_kind + = flatMapOuterTVBs bindImplicitTKBndrs_Q_Tv + (bindExplicitTKBndrs_Q_Tv ctxt_kind) + +--------------- +tcOuterSigTKBndrs :: TypeOrKind -> SkolemInfo + -> HsOuterSigTyVarBndrs GhcRn + -> TcM a -> TcM (OuterTVBs, a) +-- Push level, capture constraints, make implication +tcOuterSigTKBndrs tyki skol_info + = fmapOuterTVBs (tc_implicit_tk_bndrs skol_info bindImplicitTKBndrs_Skol) + (tcExplicitTKBndrs tyki) + + +-------------------------------------- +-- Explicit tyvar binders +-------------------------------------- tcExplicitTKBndrs :: OutputableBndrFlag flag - => TcTyMode + => TypeOrKind -> [LHsTyVarBndr flag GhcRn] -> TcM a -> TcM ([VarBndr TyVar flag], a) --- Push level, capture constraints, and emit an --- implication constraint with a ForAllSkol ic_info, so that it --- is subject to a telescope test. -tcExplicitTKBndrs mode bndrs thing_inside +tcExplicitTKBndrs tyki + = tcExplicitTKBndrs_M (mkMode tyki) + +tcExplicitTKBndrs_M :: OutputableBndrFlag flag + => TcTyMode + -> [LHsTyVarBndr flag GhcRn] + -> TcM a + -> TcM ([VarBndr TyVar flag], a) +tcExplicitTKBndrs_M mode + = tc_explicit_tk_bndrs (bindExplicitTKBndrs_Skol_M mode) + +tc_explicit_tk_bndrs + :: OutputableBndrFlag flag + => ([LHsTyVarBndr flag GhcRn] -> TcM a -> TcM ([VarBndr TyVar flag], a)) + -> [LHsTyVarBndr flag GhcRn] + -> TcM a + -> TcM ([VarBndr TyVar flag], a) +-- The workhorse: +-- push level, capture constraints, +-- and emit an implication constraint with a ForAllSkol ic_info, +-- so that it is subject to a telescope test. +tc_explicit_tk_bndrs bind_them bndrs thing_inside = do { (tclvl, wanted, (skol_tvs, res)) - <- pushLevelAndCaptureConstraints $ - bindExplicitTKBndrs_Skol_M mode bndrs $ + <- pushLevelAndCaptureConstraints $ + bind_them bndrs $ thing_inside - ; let skol_info = ForAllSkol (ppr bndrs) - ; implic <- buildTvImplication skol_info (binderVars skol_tvs) tclvl wanted - ; emitImplication implic - -- /Always/ emit this implication even if wanted is empty - -- We need the implication so that we check for a bad telescope - -- See Note [Skolem escape and forall-types] + ; let skol_info = ForAllSkol (fsep (map ppr bndrs)) + -- Notice that we use ForAllSkol here, ignoring the enclosing + -- skol_info unlike tc_implicit_tk_bndrs, because the bad-telescope + -- test applies only to ForAllSkol + ; emitResidualTvConstraint skol_info (binderVars skol_tvs) tclvl wanted ; return (skol_tvs, res) } +---------------- -- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied -- 'TcTyMode'. bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv @@ -3174,97 +3189,6 @@ bindExplicitTKBndrsX tc_tv hs_tvs thing_inside go hs_tvs ; return (Bndr tv (hsTyVarBndrFlag hs_tv):tvs, res) } --------------------------------------- --- Outer type variable binders --------------------------------------- - - --- TODO RGS: Which of these do we actually need? - --- TODO RGS: Docs(?) --- TODO RGS: Is the return type correct? --- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Tv? -bindOuterFamEqnTKBndrs_Q_Skol :: ContextKind - -> HsOuterFamEqnTyVarBndrs GhcRn - -> TcM a - -> TcM ([TcTyVar], a) -bindOuterFamEqnTKBndrs_Q_Skol ctxt_kind outer_bndrs thing_inside = case outer_bndrs of - OuterImplicit implicit_tkv_nms -> do - bindImplicitTKBndrs_Q_Skol implicit_tkv_nms thing_inside - OuterExplicit exp_bndrs -> do - bindExplicitTKBndrs_Q_Skol ctxt_kind exp_bndrs thing_inside - --- TODO RGS: Docs(?) --- TODO RGS: Is the return type correct? --- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Tv? -bindOuterFamEqnTKBndrs_Q_Tv :: ContextKind - -> HsOuterFamEqnTyVarBndrs GhcRn - -> TcM a - -> TcM ([TcTyVar], a) -bindOuterFamEqnTKBndrs_Q_Tv ctxt_kind outer_bndrs thing_inside = case outer_bndrs of - OuterImplicit implicit_tkv_nms - -> bindImplicitTKBndrs_Q_Tv implicit_tkv_nms thing_inside - OuterExplicit 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] [TcInvisTVBinder], a) -bindOuterSigTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of - OuterImplicit implicit_tkv_nms - -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside - ; pure (Left imp_tvs, thing) } - OuterExplicit 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 - OuterImplicit implicit_tv_names - -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tv_names thing_inside - ; pure (Left imp_tvs, thing) } - OuterExplicit 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? --- TODO RGS: Consolidate? -bindOuterSigTKBndrs_Skol_M :: TcTyMode - -> HsOuterSigTyVarBndrs GhcRn - -> TcM a - -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) -bindOuterSigTKBndrs_Skol_M mode outer_bndrs thing_inside = case outer_bndrs of - OuterImplicit implicit_tkv_nms - -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside - ; pure (Left imp_tvs, thing) } - OuterExplicit 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 - OuterImplicit implicit_tkv_nms - -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tkv_nms thing_inside - ; pure (mkTyVarBinders SpecifiedSpec imp_tvs, thing) } - OuterExplicit exp_bndrs - -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv_M mode exp_bndrs thing_inside - ; pure (exp_bndrs', thing) } - ----------------- tcHsTyVarBndr :: TcTyMode -> (Name -> Kind -> TcM TyVar) -> HsTyVarBndr flag GhcRn -> TcM TcTyVar @@ -3303,6 +3227,77 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind) _ -> new_tv tv_nm kind } +-------------------------------------- +-- Implicit tyvar binders +-------------------------------------- + +tc_implicit_tk_bndrs :: SkolemInfo + -> ([Name] -> TcM a -> TcM ([TcTyVar], a)) + -> [Name] + -> TcM a + -> TcM ([TcTyVar], a) +-- The workhorse: +-- push level, capture constraints, +-- and emit an implication constraint with a ForAllSkol ic_info, +-- so that it is subject to a telescope test. +tc_implicit_tk_bndrs skol_info bind_them bndrs thing_inside + = do { (tclvl, wanted, (skol_tvs, res)) + <- pushLevelAndCaptureConstraints $ + bind_them bndrs $ + thing_inside + + ; emitResidualTvConstraint skol_info skol_tvs tclvl wanted + + ; return (skol_tvs, res) } + +------------------ +bindImplicitTKBndrs_Skol, bindImplicitTKBndrs_Tv, + bindImplicitTKBndrs_Q_Skol, bindImplicitTKBndrs_Q_Tv + :: [Name] -> TcM a -> TcM ([TcTyVar], a) +bindImplicitTKBndrs_Q_Skol = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedSkolemTyVar) +bindImplicitTKBndrs_Q_Tv = bindImplicitTKBndrsX (newImplicitTyVarQ newFlexiKindedTyVarTyVar) +bindImplicitTKBndrs_Skol = bindImplicitTKBndrsX newFlexiKindedSkolemTyVar +bindImplicitTKBndrs_Tv = bindImplicitTKBndrsX cloneFlexiKindedTyVarTyVar + -- newFlexiKinded... see Note [Non-cloning for tyvar binders] + -- cloneFlexiKindedTyVarTyVar: see Note [Cloning for tyvar binders] + +bindImplicitTKBndrsX + :: (Name -> TcM TcTyVar) -- new_tv function + -> [Name] + -> TcM a + -> TcM ([TcTyVar], a) -- Returned [TcTyVar] are in 1-1 correspondence + -- with the passed in [Name] +bindImplicitTKBndrsX new_tv tv_names thing_inside + = do { tkvs <- mapM new_tv tv_names + ; traceTc "bindImplicitTKBndrs" (ppr tv_names $$ ppr tkvs) + ; res <- tcExtendNameTyVarEnv (tv_names `zip` tkvs) + thing_inside + ; return (tkvs, res) } + +newImplicitTyVarQ :: (Name -> TcM TcTyVar) -> Name -> TcM TcTyVar +-- Behave like new_tv, except that if the tyvar is in scope, use it +newImplicitTyVarQ new_tv name + = do { mb_tv <- tcLookupLcl_maybe name + ; case mb_tv of + Just (ATyVar _ tv) -> return tv + _ -> new_tv name } + +newFlexiKindedTyVar :: (Name -> Kind -> TcM TyVar) -> Name -> TcM TyVar +newFlexiKindedTyVar new_tv name + = do { kind <- newMetaKindVar + ; new_tv name kind } + +newFlexiKindedSkolemTyVar :: Name -> TcM TyVar +newFlexiKindedSkolemTyVar = newFlexiKindedTyVar newSkolemTyVar + +newFlexiKindedTyVarTyVar :: Name -> TcM TyVar +newFlexiKindedTyVarTyVar = newFlexiKindedTyVar newTyVarTyVar + +cloneFlexiKindedTyVarTyVar :: Name -> TcM TyVar +cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar + -- See Note [Cloning for tyvar binders] + + -------------------------------------- -- Binding type/class variables in the -- kind-checking and typechecking phases @@ -3734,15 +3729,15 @@ tcHsPartialSigType -- 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 _ (HsSig{sig_bndrs = hs_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)) + ; (outer_bndrs, (wcs, wcx, theta, tau)) <- solveEqualities "tcHsPartialSigType" $ -- See Note [Failure in local type signatures] - tcNamedWildCardBinders sig_wcs $ \ wcs -> - bindOuterSigTKBndrs_Tv_M mode outer_bndrs $ + tcNamedWildCardBinders sig_wcs $ \ wcs -> + bindOuterSigTKBndrs_Tv_M mode hs_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 @@ -3753,8 +3748,10 @@ tcHsPartialSigType ctxt sig_ty ; return (wcs, wcx, theta, tau) } + ; outer_tv_bndrs <- scopedSortOuter outer_bndrs + -- No kind-generalization here: - ; kindGeneralizeNone (mkInvisForAllTys imp_or_exp_tvbndrs $ + ; kindGeneralizeNone (mkInvisForAllTys outer_tv_bndrs $ mkPhiTy theta $ tau) @@ -3766,17 +3763,19 @@ tcHsPartialSigType ctxt sig_ty -- 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 + ; outer_tv_bndrs <- mapM zonkInvisTVBinder outer_tv_bndrs + ; 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 - OuterImplicit imp_tvs -> imp_tvs - OuterExplicit exp_tvs -> hsLTyVarNames exp_tvs - tv_prs = imp_or_exp_hs_tvs `zip` imp_or_exp_tvbndrs + ; let outer_bndr_names :: [Name] + outer_bndr_names = case hs_outer_bndrs of + OuterImplicit imp_tvs -> imp_tvs + OuterExplicit exp_tvs -> hsLTyVarNames exp_tvs + tv_prs :: [(Name,InvisTVBinder)] + tv_prs = outer_bndr_names `zip` outer_tv_bndrs -- NB: checkValidType on the final inferred type will be -- done later by checkInferredPolyId. We can't do it ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -269,10 +269,9 @@ 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 - OuterImplicit{} -> no_anon_wc_ty body - OuterExplicit ltvs -> all no_anon_wc_tvb ltvs && no_anon_wc_ty body +no_anon_wc_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) + = all no_anon_wc_tvb (outerExplicitBndrs outer_bndrs) + && no_anon_wc_ty body no_anon_wc_ty :: LHsType GhcRn -> Bool no_anon_wc_ty lty = go lty @@ -385,15 +384,17 @@ completely solving them. 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})) +tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_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) - ; (tclvl, wanted, (implicit_or_univ_tvbndrs, (ex_tvbndrs, (req, prov, body_ty)))) - <- pushLevelAndSolveEqualitiesX "tcPatSynSig" $ + = do { traceTc "tcPatSynSig 1" (ppr sig_ty) + + ; let skol_info = DataConSkol name + ; (tclvl, wanted, (outer_bndrs, (ex_tvbndrs, (req, prov, body_ty)))) + <- pushLevelAndSolveEqualitiesX "tcPatSynSig" $ -- See Note [solveEqualities in tcPatSynSig] - bindOuterSigTKBndrs_Skol outer_bndrs $ - bindExplicitTKBndrs_Skol ex_hs_tvbndrs $ + tcOuterSigTKBndrs TypeLevel skol_info hs_outer_bndrs $ + tcExplicitTKBndrs TypeLevel ex_hs_tvbndrs $ do { req <- tcHsContext hs_req ; prov <- tcHsContext hs_prov ; body_ty <- tcHsOpenType hs_body_ty @@ -401,11 +402,13 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = hs_ty})) -- 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 implicit_tvs :: [TcTyVar] + univ_tvbndrs :: [TcInvisTVBinder] + (implicit_tvs, univ_tvbndrs) = case outer_bndrs of + OuterImplicit implicit_tvs -> (implicit_tvs, []) + OuterExplicit univ_tvbndrs -> ([], univ_tvbndrs) + ; implicit_tvs <- zonkAndScopedSort implicit_tvs ; let ungen_patsyn_ty = build_patsyn_type [] implicit_tvs univ_tvbndrs req ex_tvbndrs prov body_ty @@ -413,9 +416,7 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = hs_ty})) ; kvs <- kindGeneralizeAll ungen_patsyn_ty ; traceTc "tcPatSynSig" (ppr ungen_patsyn_ty) - ; let skol_tvs = kvs ++ implicit_tvs ++ binderVars (univ_tvbndrs ++ ex_tvbndrs) - skol_info = DataConSkol name - ; reportUnsolvedEqualities skol_info skol_tvs tclvl wanted + ; reportUnsolvedEqualities skol_info kvs tclvl wanted -- See Note [Report unsolved equalities in tcPatSynSig] -- These are /signatures/ so we zonk to squeeze out any kind ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1939,7 +1939,7 @@ checkBadTelescope :: Implication -> TcS Bool -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint checkBadTelescope (Implic { ic_info = info , ic_skols = skols }) - | ForAllSkol {} <- info + | checkTelescopeSkol info = do{ skols <- mapM TcS.zonkTyCoVarKind skols ; return (go emptyVarSet (reverse skols))} ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -1617,7 +1617,7 @@ kcConDecl new_or_data res_kind (ConDeclGADT -- If we don't look at MkT we won't get the correct kind -- for the type constructor T addErrCtxt (dataConCtxtName names) $ - discardResult $ + discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ -- Why "_Tv"? See Note [Kind-checking for GADTs] do { _ <- tcHsMbContext cxt @@ -3261,7 +3261,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data ; (tclvl, wanted, (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $ - tcOuterSigTKBndrs outer_bndrs $ + tcOuterSigTKBndrs TypeLevel skol_info outer_bndrs $ do { ctxt <- tcHsMbContext cxt ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] @@ -3281,11 +3281,10 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data mkPhiTy ctxt $ mkVisFunTys arg_tys $ res_ty) + ; reportUnsolvedEqualities skol_info tkvs tclvl wanted ; let tvbndrs = mkTyVarBinders InferredSpec tkvs ++ outer_tv_bndrs - ; reportUnsolvedEqualities skol_info (binderVars tvbndrs) tclvl wanted - -- Zonk to Types ; (ze, tvbndrs) <- zonkTyVarBinders tvbndrs ; arg_tys <- zonkScaledTcTypesToTypesX ze arg_tys ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Tc.Types.Constraint ( isDroppableCt, insolubleImplic, arisesFromGivens, - Implication(..), implicationPrototype, + Implication(..), implicationPrototype, checkTelescopeSkol, ImplicStatus(..), isInsolubleStatus, isSolvedStatus, SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth, bumpSubGoalDepth, subGoalDepthExceeded, @@ -1176,8 +1176,8 @@ data ImplicStatus | IC_Insoluble -- At least one insoluble constraint in the tree - | IC_BadTelescope -- solved, but the skolems in the telescope are out of - -- dependency order + | IC_BadTelescope -- Solved, but the skolems in the telescope are out of + -- dependency order. See Note [Checking telescopes] | IC_Unsolved -- Neither of the above; might go either way @@ -1207,6 +1207,11 @@ instance Outputable ImplicStatus where ppr (IC_Solved { ics_dead = dead }) = text "Solved" <+> (braces (text "Dead givens =" <+> ppr dead)) +checkTelescopeSkol :: SkolemInfo -> Bool +-- See Note [Checking telescopes] +checkTelescopeSkol (ForAllSkol {}) = True +checkTelescopeSkol _ = False + {- Note [Checking telescopes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When kind-checking a /user-written/ type, we might have a "bad telescope" ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -926,13 +926,18 @@ checkTvConstraints skol_info skol_tvs thing_inside emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM () emitResidualTvConstraint skol_info skol_tvs tclvl wanted - | isEmptyWC wanted - = return () - - | otherwise - = do { implic <- buildTvImplication skol_info skol_tvs tclvl wanted + | not (isEmptyWC wanted) || + checkTelescopeSkol skol_info + = -- checkTelescopeSkol: in this case, /always/ emit this implication + -- even if 'wanted' is empty. We need the implication so that we check + -- for a bad telescope. See Note [Skolem escape and forall-types] in + -- GHC.Tc.Gen.HsType + do { implic <- buildTvImplication skol_info skol_tvs tclvl wanted ; emitImplication implic } + | otherwise -- Empty 'wanted', emit nothing + = return () + buildTvImplication :: SkolemInfo -> [TcTyVar] -> TcLevel -> WantedConstraints -> TcM Implication buildTvImplication skol_info skol_tvs tclvl wanted ===================================== testsuite/tests/polykinds/T16762.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs, DataKinds, PolyKinds, ExplicitForAll #-} + +module BadTelescope2 where + +import Data.Kind + +data SameKind :: k -> k -> * + +-- This declaration made GHC 8.10 produce a Core Lint error +data T a b where + MkT :: forall a kx (b :: kx). SameKind a b -> T a b + + ===================================== testsuite/tests/polykinds/T16762a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, GADTs, DataKinds, PolyKinds, ExplicitForAll #-} + +module T16762a where + +import Data.Kind + +data SameKind :: k -> k -> * + +type family F a + +-- This should jolly well be rejected! +type instance forall a k (b::k). F (SameKind a b) = Int + ===================================== testsuite/tests/polykinds/all.T ===================================== @@ -225,3 +225,5 @@ test('T18451', normal, compile_fail, ['']) test('T18451a', normal, compile_fail, ['']) test('T18451b', normal, compile_fail, ['']) test('T18522-ppr', normal, ghci_script, ['T18522-ppr.script']) +test('T16762', normal, compile_fail, ['']) +test('T16762a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4186227ec3956fc99c3fd117e3659634df260808 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4186227ec3956fc99c3fd117e3659634df260808 You're receiving 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 23 15:36:45 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 11:36:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T13964 Message-ID: <5f6b6b8d4491_80b3f8434f6b7681397644c@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T13964 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T13964 You're receiving 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 23 15:48:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 23 Sep 2020 11:48:07 -0400 Subject: [Git][ghc/ghc][wip/T13964] PmCheck: Only suggest imported ConLikes for missing patterns (#13964) Message-ID: <5f6b6e37d4da6_80baa10eb413984813@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T13964 at Glasgow Haskell Compiler / GHC Commits: 4421c464 by Sebastian Graf at 2020-09-23T17:48:00+02:00 PmCheck: Only suggest imported ConLikes for missing patterns (#13964) We simply `lookupGRE_Name` every `ConLike` of a `COMPLETE` set before suggesting it. Fixes #13964. - - - - - 7 changed files: - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/Types.hs - testsuite/tests/pmcheck/complete_sigs/T13964.hs - testsuite/tests/pmcheck/complete_sigs/T13964.stderr - + testsuite/tests/pmcheck/complete_sigs/T13964b.hs - testsuite/tests/pmcheck/complete_sigs/all.T Changes: ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -27,9 +27,9 @@ module GHC.HsToCore.Monad ( mkPrintUnqualifiedDs, newUnique, UniqSupply, newUniqueSupply, - getGhcModeDs, dsGetFamInstEnvs, + getGhcModeDs, dsGetFamInstEnvs, dsGetGlobalRdrEnv, dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, - dsLookupDataCon, dsLookupConLike, + dsLookupDataCon, getCCIndexDsM, DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, @@ -72,7 +72,6 @@ import GHC.Driver.Types import GHC.Data.Bag 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 @@ -302,6 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (unitState dflags) (mkHomeUnitFromFlags dflags) rdr_env + , ds_rdr_env = rdr_env , ds_msgs = msg_var , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var @@ -522,10 +522,8 @@ dsLookupDataCon :: Name -> DsM DataCon dsLookupDataCon name = tyThingDataCon <$> dsLookupGlobal name -dsLookupConLike :: Name -> DsM ConLike -dsLookupConLike name - = tyThingConLike <$> dsLookupGlobal name - +dsGetGlobalRdrEnv :: DsM GlobalRdrEnv +dsGetGlobalRdrEnv = ds_rdr_env <$> getGblEnv dsGetFamInstEnvs :: DsM FamInstEnvs -- Gets both the external-package inst-env ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -44,6 +44,7 @@ import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM import GHC.Types.Id import GHC.Types.Name +import GHC.Types.Name.Reader (GlobalRdrEnv, lookupGRE_Name) import GHC.Types.Var (EvVar) import GHC.Types.Var.Env import GHC.Types.Var.Set @@ -1737,11 +1738,16 @@ generateInhabitingPatterns (x:xs) n nabla = do pickApplicableCompleteSets :: Type -> ResidualCompleteMatches -> DsM [ConLikeSet] pickApplicableCompleteSets ty rcm = do + gre <- dsGetGlobalRdrEnv env <- dsGetFamInstEnvs - pure $ filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) + pure $ filter (all (is_valid gre env) . uniqDSetToList) (getRcm rcm) where - is_valid :: FamInstEnvs -> ConLike -> Bool - is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) + is_valid :: GlobalRdrEnv -> FamInstEnvs -> ConLike -> Bool + is_valid gre env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) + && isJust (lookupGRE_Name gre (conLikeName cl)) + -- filter out ConLikes that the User can't write, + -- because they aren't imported or not even + -- exported. This is #13964. {- Note [Why inhabitationTest doesn't call generateInhabitingPatterns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -10,6 +10,7 @@ import Data.IORef import GHC.Types.CostCentre.State import GHC.Types.Name.Env +import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) @@ -46,6 +47,8 @@ data DsGblEnv , ds_msgs :: IORef Messages -- Warning messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things + , ds_rdr_env :: GlobalRdrEnv -- ^ Used for looking up whether a + -- Name is imported or not , ds_complete_matches :: CompleteMatches -- Additional complete pattern matches , ds_cc_st :: IORef CostCentreState ===================================== testsuite/tests/pmcheck/complete_sigs/T13964.hs ===================================== @@ -3,7 +3,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} -module Bug (Boolean(F, TooGoodToBeTrue), catchAll) where +module T13964 (Boolean(F, TooGoodToBeTrue), catchAll) where data Boolean = F | T deriving Eq ===================================== testsuite/tests/pmcheck/complete_sigs/T13964.stderr ===================================== @@ -1,4 +1,11 @@ +[1 of 2] Compiling T13964 ( T13964.hs, T13964.o ) T13964.hs:18:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive In an equation for ‘catchAll’: Patterns not matched: T +[2 of 2] Compiling T13964b ( T13964b.hs, T13964b.o ) + +T13964b.hs:6:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘catchAll2’: + Patterns not matched: TooGoodToBeTrue ===================================== testsuite/tests/pmcheck/complete_sigs/T13964b.hs ===================================== @@ -0,0 +1,7 @@ +module T13964b where + +import T13964 + +catchAll2 :: Boolean -> Int +catchAll2 F = 0 +-- catchAll2 TooGoodToBeTrue = 1 ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -16,7 +16,7 @@ test('T13021', normal, compile, ['']) test('T13363a', normal, compile, ['']) test('T13363b', normal, compile, ['']) test('T13717', normal, compile, ['']) -test('T13964', normal, compile, ['']) +test('T13964', normal, multimod_compile, ['T13964b', '-W']) test('T13965', normal, compile, ['']) test('T14059a', normal, compile, ['']) test('T14059b', expect_broken('14059'), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4421c464b93480dd7eac719c1ef7b81a2a7de8dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4421c464b93480dd7eac719c1ef7b81a2a7de8dd You're receiving 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 23 17:00:46 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Wed, 23 Sep 2020 13:00:46 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 4 commits: Replace uint with unsigned int. Needed for validate-x86_64-darwin build. Message-ID: <5f6b7f3e79157_80b3f8486a489501399425d@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 9e427210 by David Eichmann at 2020-09-23T11:52:10+01:00 Replace uint with unsigned int. Needed for validate-x86_64-darwin build. - - - - - cde7ebbd by David Eichmann at 2020-09-23T11:59:33+01:00 Fix warnings - - - - - 7198d60e by David Eichmann at 2020-09-23T17:16:25+01:00 Error instead of deadlock when calling rts_lock after rts_pause - - - - - fcd2bb45 by David Eichmann at 2020-09-23T18:00:15+01:00 Move and rewrite NOTE on RtsAPI thread safety - - - - - 13 changed files: - includes/RtsAPI.h - rts/RtsAPI.c - testsuite/tests/rts/ghc-debug/all.T - testsuite/tests/rts/ghc-debug/shouldfail/all.T - + testsuite/tests/rts/ghc-debug/shouldfail/deadlock.c - + testsuite/tests/rts/ghc-debug/shouldfail/deadlock.h - + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.hs - + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stderr - + testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stdout - + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.hs - + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stderr - + testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stdout - testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs Changes: ===================================== includes/RtsAPI.h ===================================== @@ -487,13 +487,13 @@ void rts_checkSchedStatus (char* site, Capability *); SchedulerStatus rts_getSchedStatus (Capability *cap); // Halt execution of all Haskell threads by acquiring all capabilities (safe FFI -// calls may continue). rts_resume() must later be called on the same thread to +// calls may continue). rts_resume must later be called on the same thread to // resume the RTS. Only one thread at a time can keep the rts paused. The // rts_pause function will block until the current thread is given exclusive -// permission to pause the RTS. If the RTS was already paused by the current OS +// permission to pause the RTS. If the RTS is already paused by the current OS // thread, then rts_pause will return immediately and have no effect. Returns a // token which may be used to create new objects and evaluate them (like -// rts_lock) .This is different to rts_lock() which only pauses a single +// rts_lock) .This is different to rts_lock which only pauses a single // capability. Calling rts_pause in between rts_lock/rts_unlock will cause a // deadlock. Capability * rts_pause (void); ===================================== rts/RtsAPI.c ===================================== @@ -578,6 +578,12 @@ rts_getSchedStatus (Capability *cap) return cap->running_task->incall->rstat; } +#if defined(THREADED_RTS) +// The task that paused the RTS. The rts_pausing_task variable is owned by the +// task that owns all capabilities (there is at most one such task). +Task * rts_pausing_task = NULL; +#endif + Capability * rts_lock (void) { @@ -594,6 +600,14 @@ rts_lock (void) stg_exit(EXIT_FAILURE); } +#if defined(THREADED_RTS) + if (rts_pausing_task == task) { + errorBelch("error: rts_lock: The RTS is already paused by this thread.\n" + " There is no need to call rts_lock if you have already call rts_pause."); + stg_exit(EXIT_FAILURE); + } +#endif + cap = NULL; waitForCapability(&cap, task); @@ -647,9 +661,37 @@ rts_unlock (Capability *cap) } #if defined(THREADED_RTS) -// The task that paused the RTS. The rts_pausing_task variable is owned by the -// task that owns all capabilities (there is at most one such task). -Task * rts_pausing_task = NULL; + +/* + * NOTE RtsAPI thread safety: + * + * Although it's likely sufficient for many use cases to call RtsAPI.h functions + * from a single thread, we still want to ensure that the API is thread safe. + * This is achieved almost entirely by the mechanism of acquiring and releasing + * Capabilities, resulting in a sort of mutex / critical section pattern. + * Correct usage of this API requires that you surround API calls in + * rts_lock/rts_unlock or rts_pause/rts_resume. These ensure that the thread + * owns a capability while calling other RtsAPI functions (in the case of + * rts_pause/rts_resume the thread owns *all* capabilities). + * + * With the capability(s) acquired GC cannot run. That allows access to the heap + * without objects unexpectedly moving, which is important for many of the + * functions in RtsAPI. + * + * Another important consequence is: + * + * * There are at most `n_capabilities` threads currently in a + * rts_lock/rts_unlock section. + * * There is at most 1 threads in a rts_pause/rts_resume section. In that case + * there will be no threads in a rts_lock/rts_unlock section. + * * rts_pause and rts_lock may block in order to enforce the above 2 + * invariants. + * + * In particular, by ensuring that that code does not block indefinitely in a + * rts_lock/rts_unlock or rts_pause/rts_resume section, we can be confident that + * the RtsAPI functions will not cause a deadlock even when many threads are + * attempting to use the RtsAPI concurrently. + */ // See RtsAPI.h Capability * rts_pause (void) @@ -679,62 +721,6 @@ Capability * rts_pause (void) stg_exit(EXIT_FAILURE); } - // NOTE ghc-debug deadlock: - // - // stopAllCapabilities attempts to acquire all capabilities and will only - // block if an existing thread/task: - // - // 1. Owns a capability and - // 2. Is deadlocked i.e. refuses to yield/release its capability. - // - // Let's assume the rest of the RTS is deadlock free (tasks will eventually - // yield their capability) outside of using the ghc-debug API: - // - // * rts_pause - // * rts_resume - // * rts_isPaused - // * rts_listThreads - // * rts_listMiscRoots - // - // Except rts_pause, none of these functions acquire a lock and so cannot - // block. rts_pause may block on stopAllCapabilities, but we ensure that the - // current task does not own a capability before calling - // stopAllCapabilities. Hence, (1) does not hold given an isolated call to - // rts_pause. The only lose end is that after rts_pause, we now have a task - // that (by design) owns all capabilities (point (1) above) and is refusing - // to yield them (point (2) above). Indeed, if 2 threads concurrently call - // rts_pause, one will block until the other calls rts_resume. As "correct - // usage" of this API requires calling rts_resume, this case is a non-issue, - // but does imply the awkward quirk that if you call rts_pause on many - // threads, they will all "take turns" pausing the rts, blocking until it is - // their turn. In adition, any API function that attempts to acquire a - // capability (e.g. rts_lock), will block until rts_resume is called. Of - // course, all ghc-debug API functions besides rts_pause do not attempt to - // acquire a capability. - // - // The moral to this story is that you will not dealock as long as you, on - // the same thread: - // - // * First call rts_pause - // * Then avoid rts functions other than: - // * rts_isPaused - // * rts_listThreads - // * rts_listMiscRoots - // * AND dereferencing/inspect the heap directly e.g. using - // rts_listThreads/rts_listMiscRoots and the ghc-heap library. - // * Finally call rts_resume - // - // TODO - // - // I think we should return Capability*. We should be able to use the rest - // of the rts API with that token. There are a few functions that take - // `Capability **` implying that it may change capabilities. I need to - // confirm, but I think that in our case, we'll just end up with the same - // capability since all others are acquired already. These other API - // functions may change the heap, but it is up to the caller to account for - // that. Is it possible that the API can be used to start executing a - // haskell thread?!?!?! That's perhaps ok as long as we reacquire the - // capability at the end so we're paused. task = newBoundTask(); // TODO I'm not sure why we need this. rts_lock does this. stopAllCapabilities(NULL, task); @@ -763,7 +749,7 @@ void rts_resume (Capability * cap STG_UNUSED) } // Check that we own all capabilities. - for (uint i = 0; i < n_capabilities; i++) + for (unsigned int i = 0; i < n_capabilities; i++) { Capability *cap = capabilities[i]; if (cap->running_task != task) @@ -791,7 +777,7 @@ bool rts_isPaused(void) // Check that the rts_pause was called on this thread/task. If not, outputs an // error and exits with EXIT_FAILURE. -void assert_isPausedOnMyTask(void) +static void assert_isPausedOnMyTask(void) { if (rts_pausing_task == NULL) { @@ -848,14 +834,16 @@ void rts_listMiscRoots (ListRootsCb cb, void *user) } #else -Capability * rts_pause (void) +Capability * GNU_ATTRIBUTE(__noreturn__) +rts_pause (void) { errorBelch("Warning: Pausing the RTS is only possible for " "multithreaded RTS."); stg_exit(EXIT_FAILURE); } -void rts_resume (Capability * cap) +void GNU_ATTRIBUTE(__noreturn__) +rts_resume (Capability * cap STG_UNUSED) { errorBelch("Warning: Unpausing the RTS is only possible for " "multithreaded RTS."); ===================================== testsuite/tests/rts/ghc-debug/all.T ===================================== @@ -1,8 +1,12 @@ -test('ghc_debug_01', [extra_files(['ghc_debug.c','ghc_debug.h'])], - multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_02', [extra_files(['ghc_debug.c','ghc_debug.h'])], - multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_03', [extra_files(['ghc_debug.c','ghc_debug.h'])], - multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '-threaded ']) -test('ghc_debug_04', [extra_files(['ghc_debug.c','ghc_debug.h'])], - multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], '-threaded ']) +test('ghc_debug_01', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']), + extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_01', [('ghc_debug.c','')], '']) +test('ghc_debug_02', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']), + extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_02', [('ghc_debug.c','')], '']) +test('ghc_debug_03', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']), + extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_03', [('ghc_debug.c','')], '']) +test('ghc_debug_04', [only_ways(['threaded1', 'threaded2']), extra_ways(['threaded1', 'threaded2']), + extra_files(['ghc_debug.c','ghc_debug.h'])], + multi_compile_and_run, ['ghc_debug_04', [('ghc_debug.c','')], '']) ===================================== testsuite/tests/rts/ghc-debug/shouldfail/all.T ===================================== @@ -1 +1,16 @@ -test('unsafe_rts_pause', [exit_code(1)], compile_and_run, ['-threaded ']) \ No newline at end of file + +test('unsafe_rts_pause', [only_ways(['threaded1']), exit_code(1)], compile_and_run, ['']) +test('rts_lock_when_paused_deadlock', + [ only_ways(['threaded1', 'threaded2']), + extra_ways(['threaded1', 'threaded2']), + exit_code(1), + extra_files(['deadlock.c','deadlock.h']) + ], + multi_compile_and_run, ['rts_lock_when_paused_deadlock', [('deadlock.c','')], '']) +test('rts_pause_when_locked_deadlock', + [ only_ways(['threaded1', 'threaded2']), + extra_ways(['threaded1', 'threaded2']), + exit_code(1), + extra_files(['deadlock.c','deadlock.h']) + ], + multi_compile_and_run, ['rts_pause_when_locked_deadlock', [('deadlock.c','')], '']) \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/deadlock.c ===================================== @@ -0,0 +1,59 @@ +#include +#include + +#include "Rts.h" +#include "RtsAPI.h" + +#include "deadlock.h" + +// Although we expect errors rather than deadlock, we don't want a failed test +// to be a deadlocked test. Hence we use this as a 1 second timeout mechanism. +void assertDoneAfterOneSecond(int * done) +{ + sleep(1); + if (!*done) + { + printf("Deadlock detected."); + exit(1); + } +} + +void lockThenPause (int * done) { + printf("Locking..."); + Capability * lockCap = rts_lock(); + printf("Locked\n"); + + printf("Pausing..."); + Capability * pauseCap = rts_pause(); + printf("Paused\n"); + + printf("Resuming..."); + rts_resume(pauseCap); + printf("Resumed\n"); + + printf("Unlocking..."); + rts_unlock(lockCap); + printf("Unlocked\n"); + + *done = 1; +} + +void pauseThenLock (int * done) { + printf("Pausing..."); + Capability * pauseCap = rts_pause(); + printf("Paused\n"); + + printf("Locking..."); + Capability * lockCap = rts_lock(); + printf("Locked\n"); + + printf("Unlocking..."); + rts_unlock(lockCap); + printf("Unlocked\n"); + + printf("Resuming..."); + rts_resume(pauseCap); + printf("Resumed\n"); + + *done = 1; +} ===================================== testsuite/tests/rts/ghc-debug/shouldfail/deadlock.h ===================================== @@ -0,0 +1,4 @@ + +void assertDoneAfterOneSecond(int * done); +void lockThenPause (int * done); +void pauseThenLock (int * done); ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Control.Concurrent +import Foreign +import Foreign.C +import System.Exit +import System.Timeout + +foreign import ccall safe "deadlock.h assertDoneAfterOneSecond" + safe_assertDoneAfterOneSecond_c :: Ptr CInt -> IO () + +foreign import ccall safe "deadlock.h lockThenPause" + safe_lockThenPause_c :: Ptr CInt -> IO () + +main :: IO () +main = alloca $ \donePtr -> do + poke donePtr 0 + forkOS $ safe_assertDoneAfterOneSecond_c donePtr + safe_lockThenPause_c donePtr ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stderr ===================================== @@ -0,0 +1,2 @@ +rts_lock_when_paused_deadlock: error: rts_pause: attempting to pause from a Task that owns a capability. + Have you already acquired a capability e.g. with rts_lock? ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_lock_when_paused_deadlock.stdout ===================================== @@ -0,0 +1,2 @@ +Locking...Locked +Pausing... \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Control.Concurrent +import Foreign +import Foreign.C +import System.Exit +import System.Timeout + +foreign import ccall safe "deadlock.h assertDoneAfterOneSecond" + safe_assertDoneAfterOneSecond_c :: Ptr CInt -> IO () + +foreign import ccall safe "deadlock.h pauseThenLock" + safe_pauseThenLock_c :: Ptr CInt -> IO () + +main :: IO () +main = alloca $ \donePtr -> do + poke donePtr 0 + forkOS $ safe_assertDoneAfterOneSecond_c donePtr + safe_pauseThenLock_c donePtr ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stderr ===================================== @@ -0,0 +1,2 @@ +rts_pause_when_locked_deadlock: error: rts_lock: The RTS is already paused by this thread. + There is no need to call rts_lock if you have already call rts_pause. ===================================== testsuite/tests/rts/ghc-debug/shouldfail/rts_pause_when_locked_deadlock.stdout ===================================== @@ -0,0 +1,2 @@ +Pausing...Paused +Locking... \ No newline at end of file ===================================== testsuite/tests/rts/ghc-debug/shouldfail/unsafe_rts_pause.hs ===================================== @@ -8,10 +8,10 @@ import Foreign.Ptr import System.Mem import Control.Monad -data RtsPause +data Capability foreign import ccall unsafe "RtsAPI.h rts_pause" - unsafe_rts_pause_c :: IO (Ptr RtsPause) + unsafe_rts_pause_c :: IO (Ptr Capability) main :: IO () main = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daddf2b184bc79fd51823aae83a790acf76020d5...fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daddf2b184bc79fd51823aae83a790acf76020d5...fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d You're receiving 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 23 19:02:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 23 Sep 2020 15:02:37 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f6b9bcd3d6b6_80b3f837b6087c01401362e@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 Wed Sep 23 19:02:38 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 23 Sep 2020 15:02:38 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: Bump Win32 submodule Message-ID: <5f6b9bce966d_80b3f84955cff1814013829@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: fbdc93e7 by Ben Gamari at 2020-09-21T15:27:17-04:00 Bump Win32 submodule - - - - - 17740c20 by Ben Gamari at 2020-09-21T15:27:17-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. (cherry picked from commit a89c2fbab9bcf7d769e9d27262ab29f93342f114) Modified to use happy-1.19 - - - - - d4d44edb by Ben Gamari at 2020-09-22T17:05:52-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). (cherry picked from commit 2f7ef2fb3234cdfb89b3da1298fc9c1b7381e418) - - - - - 2 changed files: - .gitlab/ci.sh - libraries/Win32 Changes: ===================================== .gitlab/ci.sh ===================================== @@ -8,6 +8,8 @@ set -e -o pipefail # Configuration: hackage_index_state="@1579718451" +MIN_ALEX_VERSION="3.2" + # Colors BLACK="0;30" GRAY="1;30" @@ -168,6 +170,7 @@ function set_toolchain_paths() { HAPPY="$HOME/.cabal/bin/happy" ALEX="$HOME/.cabal/bin/alex" fi + export GHC export CABAL export HAPPY @@ -279,24 +282,25 @@ 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 \ + --index-state=$hackage_index_state \ + --installdir=$toolchain/bin \ + --overwrite-policy=always" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; *) ;; 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==1.19.*" + + info "Building alex..." + $cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION" } function cleanup_submodules() { ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit ca5fbc12851b98a52f96a43ea19c54c9ecf0f9e3 +Subproject commit d68374423fa3d3edd6b776e412e4093cc69b5f64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f91ea170d86fab45a9f4658b8b02f4adede9aef7...d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f91ea170d86fab45a9f4658b8b02f4adede9aef7...d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd You're receiving 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 23 20:45:41 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 23 Sep 2020 16:45:41 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 20 commits: Resolve shift/reduce conflicts with %shift (#17232) Message-ID: <5f6bb3f539fc3_80b3f849bb769ac140188c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 5fb04dbf by Ben Gamari at 2020-09-23T16:43:43-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 8b752ea7 by Ben Gamari at 2020-09-23T16:45:16-04:00 testsuite: Mark Win32 as broken on Windows Due to #17945. - - - - - 18 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Hs/Expr.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/HsToCore/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41534efcf6e8ae8f6e19e1c6f0b831bc92dc3011...8b752ea76212ee92d760516efbf515c2cac41776 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41534efcf6e8ae8f6e19e1c6f0b831bc92dc3011...8b752ea76212ee92d760516efbf515c2cac41776 You're receiving 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 24 00:43:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 20:43:58 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Refactor CLabel pretty-printing Message-ID: <5f6bebce447b2_80b3f8486a71058140403c4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 10 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -17,8 +17,9 @@ module GHC.Cmm.CLabel ( CLabel, -- abstract type NeedExternDecl (..), ForeignLabelSource(..), - pprDebugCLabel, + DynamicLinkerLabelInfo(..), + -- * Constructors mkClosureLabel, mkSRTLabel, mkInfoTableLabel, @@ -68,7 +69,6 @@ module GHC.Cmm.CLabel ( mkSelectorInfoLabel, mkSelectorEntryLabel, - mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, @@ -77,44 +77,52 @@ module GHC.Cmm.CLabel ( mkCmmDataLabel, mkRtsCmmDataLabel, mkCmmClosureLabel, - mkRtsApFastLabel, - mkPrimCallLabel, - mkForeignLabel, - addLabelSize, - - foreignLabelStdcallInfo, - isBytesLabel, - isForeignLabel, - isSomeRODataLabel, - isStaticClosureLabel, - mkCCLabel, mkCCSLabel, - - DynamicLinkerLabelInfo(..), + mkCCLabel, + mkCCSLabel, mkDynamicLinkerLabel, - dynamicLinkerLabelInfo, - mkPicBaseLabel, mkDeadStripPreventer, - mkHpcTicksLabel, -- * Predicates hasCAF, - needsCDecl, maybeLocalBlockLabel, externallyVisibleCLabel, + needsCDecl, + maybeLocalBlockLabel, + externallyVisibleCLabel, isMathFun, - isCFunctionLabel, isGcPtrLabel, labelDynamic, - isLocalCLabel, mayRedirectTo, + isCFunctionLabel, + isGcPtrLabel, + labelDynamic, + isLocalCLabel, + mayRedirectTo, + isInfoTableLabel, + isConInfoTableLabel, + isIdLabel, + isTickyLabel, + hasHaskellName, + isBytesLabel, + isForeignLabel, + isSomeRODataLabel, + isStaticClosureLabel, -- * Conversions - toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, + toClosureLbl, + toSlowEntryLbl, + toEntryLbl, + toInfoLbl, - pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC, - isInfoTableLabel, - isConInfoTableLabel, - isIdLabel, isTickyLabel + -- * Pretty-printing + LabelStyle (..), + pprDebugCLabel, + pprCLabel, + + -- * Others + dynamicLinkerLabelInfo, + addLabelSize, + foreignLabelStdcallInfo ) where #include "HsVersions.h" @@ -133,7 +141,6 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Data.FastString import GHC.Driver.Session -import GHC.Driver.Backend import GHC.Platform import GHC.Types.Unique.Set import GHC.Utils.Misc @@ -403,23 +410,22 @@ data ForeignLabelSource -- The regular Outputable instance only shows the label name, and not its other info. -- pprDebugCLabel :: Platform -> CLabel -> SDoc -pprDebugCLabel platform lbl - = case lbl of - IdLabel _ _ info-> pprCLabel_other platform lbl - <> (parens $ text "IdLabel" - <> whenPprDebug (text ":" <> text (show info))) - CmmLabel pkg _ext _name _info - -> pprCLabel_other platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg) +pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra + where + extra = case lbl of + IdLabel _ _ info + -> text "IdLabel" <> whenPprDebug (text ":" <> text (show info)) + + CmmLabel pkg _ext _name _info + -> text "CmmLabel" <+> ppr pkg - RtsLabel{} -> pprCLabel_other platform lbl <> (parens $ text "RtsLabel") + RtsLabel{} + -> text "RtsLabel" - ForeignLabel _name mSuffix src funOrData - -> pprCLabel_other platform lbl <> (parens $ text "ForeignLabel" - <+> ppr mSuffix - <+> ppr src - <+> ppr funOrData) + ForeignLabel _name mSuffix src funOrData + -> text "ForeignLabel" <+> ppr mSuffix <+> ppr src <+> ppr funOrData - _ -> pprCLabel_other platform lbl <> (parens $ text "other CLabel") + _ -> text "other CLabel" data IdLabelInfo @@ -760,13 +766,13 @@ toClosureLbl :: Platform -> CLabel -> CLabel toClosureLbl platform lbl = case lbl of IdLabel n c _ -> IdLabel n c Closure CmmLabel m ext str _ -> CmmLabel m ext str CmmClosure - _ -> pprPanic "toClosureLbl" (pprCLabel_other platform lbl) + _ -> pprPanic "toClosureLbl" (pprDebugCLabel platform lbl) toSlowEntryLbl :: Platform -> CLabel -> CLabel toSlowEntryLbl platform lbl = case lbl of IdLabel n _ BlockInfoTable -> pprPanic "toSlowEntryLbl" (ppr n) IdLabel n c _ -> IdLabel n c Slow - _ -> pprPanic "toSlowEntryLbl" (pprCLabel_other platform lbl) + _ -> pprPanic "toSlowEntryLbl" (pprDebugCLabel platform lbl) toEntryLbl :: Platform -> CLabel -> CLabel toEntryLbl platform lbl = case lbl of @@ -777,7 +783,7 @@ toEntryLbl platform lbl = case lbl of IdLabel n c _ -> IdLabel n c Entry CmmLabel m ext str CmmInfo -> CmmLabel m ext str CmmEntry CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet - _ -> pprPanic "toEntryLbl" (pprCLabel_other platform lbl) + _ -> pprPanic "toEntryLbl" (pprDebugCLabel platform lbl) toInfoLbl :: Platform -> CLabel -> CLabel toInfoLbl platform lbl = case lbl of @@ -786,7 +792,7 @@ toInfoLbl platform lbl = case lbl of IdLabel n c _ -> IdLabel n c InfoTable CmmLabel m ext str CmmEntry -> CmmLabel m ext str CmmInfo CmmLabel m ext str CmmRet -> CmmLabel m ext str CmmRetInfo - _ -> pprPanic "CLabel.toInfoLbl" (pprCLabel_other platform lbl) + _ -> pprPanic "CLabel.toInfoLbl" (pprDebugCLabel platform lbl) hasHaskellName :: CLabel -> Maybe Name hasHaskellName (IdLabel n _ _) = Just n @@ -1214,36 +1220,32 @@ and are not externally visible. -} instance OutputableP Platform CLabel where - pdoc platform lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) platform lbl) - -pprCLabel :: Backend -> Platform -> CLabel -> SDoc -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 -> + pdoc platform lbl = getPprStyle $ \case + PprCode CStyle -> pprCLabel platform CStyle lbl + PprCode AsmStyle -> pprCLabel platform AsmStyle lbl + _ -> pprCLabel platform CStyle lbl + -- default to CStyle + +pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc +pprCLabel platform sty lbl = let -- some platform (e.g. Darwin) require a leading "_" for exported asm -- symbols maybe_underscore :: SDoc -> SDoc - maybe_underscore doc = - if platformLeadingUnderscore platform - then pp_cSEP <> doc - else doc + maybe_underscore doc = case sty of + AsmStyle | platformLeadingUnderscore platform -> pp_cSEP <> doc + _ -> doc + + tempLabelPrefixOrUnderscore :: Platform -> SDoc + tempLabelPrefixOrUnderscore platform = case sty of + AsmStyle -> ptext (asmTempLabelPrefix platform) + CStyle -> char '_' + in case lbl of - LocalBlockLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + LocalBlockLabel u -> case sty of + AsmStyle -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u + CStyle -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u AsmTempLabel u -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u @@ -1252,11 +1254,11 @@ pprCLabel_NCG platform lbl = getPprStyle $ \sty -> -> ptext (asmTempLabelPrefix platform) <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u - _other -> pprCLabel_NCG platform l + _other -> pprCLabel platform sty l <> ftext suf DynamicLinkerLabel info lbl - -> pprDynamicLinkerAsmLabel platform info lbl + -> pprDynamicLinkerAsmLabel platform info (pprCLabel platform AsmStyle lbl) PicBaseLabel -> text "1b" @@ -1269,127 +1271,109 @@ pprCLabel_NCG platform lbl = getPprStyle $ \sty -> optional `_` (underscore) because this is how you mark non-temp symbols on some platforms (Darwin) -} - maybe_underscore $ text "dsp_" <> pprCLabel_NCG platform lbl <> text "_dsp" + maybe_underscore $ text "dsp_" <> pprCLabel platform sty lbl <> text "_dsp" StringLitLabel u - -> pprUniqueAlways u <> ptext (sLit "_str") + -> maybe_underscore $ pprUniqueAlways u <> ptext (sLit "_str") ForeignLabel fs (Just sz) _ _ - | asmStyle sty + | AsmStyle <- 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 - _ | asmStyle sty -> maybe_underscore $ pprCLabel_common platform lbl - | otherwise -> pprCLabel_common platform lbl - -pprCLabel_other :: Platform -> CLabel -> SDoc -pprCLabel_other platform lbl = - case lbl of - LocalBlockLabel u - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - - AsmTempLabel u - | not (platformUnregisterised platform) - -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u - - lbl -> pprCLabel_common platform lbl - - -pprCLabel_common :: Platform -> CLabel -> SDoc -pprCLabel_common platform = \case - (StringLitLabel u) -> pprUniqueAlways u <> text "_str" - (SRTLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" - (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform - <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" - -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') - -- 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 - - (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u - - (RtsLabel (RtsApFast (NonDetFastString str))) -> ftext str <> text "_fast" - - (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) -> - hcat [text "stg_sel_", text (show offset), - ptext (if upd_reqd - then (sLit "_upd_info") - else (sLit "_noupd_info")) - ] - - (RtsLabel (RtsSelectorEntry upd_reqd offset)) -> - hcat [text "stg_sel_", text (show offset), - ptext (if upd_reqd - then (sLit "_upd_entry") - else (sLit "_noupd_entry")) - ] - - (RtsLabel (RtsApInfoTable upd_reqd arity)) -> - hcat [text "stg_ap_", text (show arity), - ptext (if upd_reqd - then (sLit "_upd_info") - else (sLit "_noupd_info")) - ] - - (RtsLabel (RtsApEntry upd_reqd arity)) -> - hcat [text "stg_ap_", text (show arity), - ptext (if upd_reqd - then (sLit "_upd_entry") - 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" - - (RtsLabel (RtsPrimOp primop)) -> text "stg_" <> ppr primop - (RtsLabel (RtsSlowFastTickyCtr pat)) -> - text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr") - - (ForeignLabel str _ _ _) -> ftext str - - (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 - (HpcTicksLabel mod) -> text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc") - - (AsmTempLabel {}) -> panic "pprCLabel_common AsmTempLabel" - (AsmTempDerivedLabel {}) -> panic "pprCLabel_common AsmTempDerivedLabel" - (DynamicLinkerLabel {}) -> panic "pprCLabel_common DynamicLinkerLabel" - (PicBaseLabel {}) -> panic "pprCLabel_common PicBaseLabel" - (DeadStripPreventer {}) -> panic "pprCLabel_common DeadStripPreventer" + ForeignLabel fs _ _ _ + -> maybe_underscore $ ftext fs + + + IdLabel name _cafs flavor -> case sty of + AsmStyle -> maybe_underscore $ internalNamePrefix <> ppr name <> ppIdFlavor flavor + where + isRandomGenerated = not (isExternalName name) + internalNamePrefix = + if isRandomGenerated + then ptext (asmTempLabelPrefix platform) + else empty + CStyle -> ppr name <> ppIdFlavor flavor + + SRTLabel u + -> maybe_underscore $ tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt" + + RtsLabel (RtsApFast (NonDetFastString str)) + -> maybe_underscore $ ftext str <> text "_fast" + + RtsLabel (RtsSelectorInfoTable upd_reqd offset) + -> maybe_underscore $ hcat [text "stg_sel_", text (show offset), + ptext (if upd_reqd + then (sLit "_upd_info") + else (sLit "_noupd_info")) + ] + + RtsLabel (RtsSelectorEntry upd_reqd offset) + -> maybe_underscore $ hcat [text "stg_sel_", text (show offset), + ptext (if upd_reqd + then (sLit "_upd_entry") + else (sLit "_noupd_entry")) + ] + + RtsLabel (RtsApInfoTable upd_reqd arity) + -> maybe_underscore $ hcat [text "stg_ap_", text (show arity), + ptext (if upd_reqd + then (sLit "_upd_info") + else (sLit "_noupd_info")) + ] + + RtsLabel (RtsApEntry upd_reqd arity) + -> maybe_underscore $ hcat [text "stg_ap_", text (show arity), + ptext (if upd_reqd + then (sLit "_upd_entry") + else (sLit "_noupd_entry")) + ] + + RtsLabel (RtsPrimOp primop) + -> maybe_underscore $ text "stg_" <> ppr primop + + RtsLabel (RtsSlowFastTickyCtr pat) + -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr") + + LargeBitmapLabel u + -> maybe_underscore $ tempLabelPrefixOrUnderscore platform + <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" + -- Some bitmaps for tuple constructors have a numeric tag (e.g. '7') + -- until that gets resolved we'll just force them to start + -- with a letter so the label will be legal assembly code. + + HpcTicksLabel mod + -> maybe_underscore $ text "_hpc_tickboxes_" <> ppr mod <> ptext (sLit "_hpc") + + CC_Label cc -> maybe_underscore $ ppr cc + CCS_Label ccs -> maybe_underscore $ ppr ccs + + CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs + CmmLabel _ _ fs CmmData -> maybe_underscore $ ftext fs + CmmLabel _ _ fs CmmPrimCall -> maybe_underscore $ ftext fs + CmmLabel _ _ fs CmmInfo -> maybe_underscore $ ftext fs <> text "_info" + CmmLabel _ _ fs CmmEntry -> maybe_underscore $ ftext fs <> text "_entry" + CmmLabel _ _ fs CmmRetInfo -> maybe_underscore $ ftext fs <> text "_info" + CmmLabel _ _ fs CmmRet -> maybe_underscore $ ftext fs <> text "_ret" + CmmLabel _ _ fs CmmClosure -> maybe_underscore $ ftext fs <> text "_closure" -ppIdFlavor :: IdLabelInfo -> SDoc -ppIdFlavor x = pp_cSEP <> text - (case x of - Closure -> "closure" - InfoTable -> "info" - LocalInfoTable -> "info" - Entry -> "entry" - LocalEntry -> "entry" - Slow -> "slow" - RednCounts -> "ct" - ConEntry -> "con_entry" - ConInfoTable -> "con_info" - ClosureTable -> "closure_tbl" - Bytes -> "bytes" - BlockInfoTable -> "info" - ) +ppIdFlavor :: IdLabelInfo -> SDoc +ppIdFlavor x = pp_cSEP <> case x of + Closure -> text "closure" + InfoTable -> text "info" + LocalInfoTable -> text "info" + Entry -> text "entry" + LocalEntry -> text "entry" + Slow -> text "slow" + RednCounts -> text "ct" + ConEntry -> text "con_entry" + ConInfoTable -> text "con_info" + ClosureTable -> text "closure_tbl" + Bytes -> text "bytes" + BlockInfoTable -> text "info" pp_cSEP :: SDoc pp_cSEP = char '_' @@ -1402,14 +1386,6 @@ instance Outputable ForeignLabelSource where ForeignLabelInThisPackage -> parens $ text "this package" ForeignLabelInExternalPackage -> parens $ text "external package" -tempLabelPrefixOrUnderscore :: Platform -> SDoc -tempLabelPrefixOrUnderscore platform = - getPprStyle $ \ sty -> - if asmStyle sty then - ptext (asmTempLabelPrefix platform) - else - char '_' - -- ----------------------------------------------------------------------------- -- Machine-dependent knowledge about labels. @@ -1419,8 +1395,8 @@ asmTempLabelPrefix platform = case platformOS platform of OSAIX -> sLit "__L" -- follow IBM XL C's convention _ -> sLit ".L" -pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc -pprDynamicLinkerAsmLabel platform dllInfo lbl = +pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc +pprDynamicLinkerAsmLabel platform dllInfo ppLbl = case platformOS platform of OSDarwin | platformArch platform == ArchX86_64 -> @@ -1449,7 +1425,6 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl = _ -> panic "pprDynamicLinkerAsmLabel" where - ppLbl = pprCLabel_NCG platform lbl elfLabel | platformArch platform == ArchPPC = case dllInfo of ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -803,7 +803,7 @@ makeImportsDoc dflags imports doPpr lbl = (lbl, renderWithContext (ncgAsmContext config) - (pprCLabel_NCG platform lbl)) + (pprCLabel platform AsmStyle lbl)) -- ----------------------------------------------------------------------------- -- Generate jump tables @@ -1149,7 +1149,7 @@ cmmExprNative referenceKind expr = do initNCGConfig :: DynFlags -> NCGConfig initNCGConfig dflags = NCGConfig { ncgPlatform = targetPlatform dflags - , ncgAsmContext = initSDocContext dflags (mkCodeStyle AsmStyle) + , ncgAsmContext = initSDocContext dflags (PprCode AsmStyle) , ncgProcAlignment = cmmProcAlignment dflags , ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags , ncgPIC = positionIndependent dflags ===================================== compiler/GHC/CmmToAsm/Dwarf/Types.hs ===================================== @@ -164,9 +164,8 @@ pprDwarfInfo platform haveSrc d -- | Print a CLabel name in a ".stringz \"LABEL\"" pprLabelString :: Platform -> CLabel -> SDoc pprLabelString platform label = - pprString' -- we don't need to escape the string as labels don't contain exotic characters - $ withPprStyle (mkCodeStyle CStyle) -- force CStyle (foreign labels may be printed differently in AsmStyle) - $ pprCLabel_NCG platform label + pprString' -- we don't need to escape the string as labels don't contain exotic characters + $ pprCLabel platform CStyle label -- pretty-print as C label (foreign labels may be printed differently in Asm) -- | Prints assembler data corresponding to DWARF info records. Note -- that the binary format of this is parameterized in @abbrevDecls@ and ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -699,7 +699,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of _ -> panic "PIC.pprImportedSymbol: no match" where platform = ncgPlatform config - ppr_lbl = pprCLabel_NCG platform + ppr_lbl = pprCLabel platform AsmStyle arch = platformArch platform os = platformOS platform pic = ncgPIC config ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -91,7 +91,7 @@ pprTop platform = \case blankLine, extern_decls, (if (externallyVisibleCLabel clbl) - then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace, + then mkFN_ else mkIF_) (pprCLabel platform CStyle 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 ", pprCLabel_ViaC platform lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel platform CStyle lbl, text "[] = ", pprStringInCStyle str, semi ] (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel platform CStyle 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, pprCLabel_ViaC platform lbl, text "[]" + , space, pprCLabel platform CStyle 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 (pprCLabel_ViaC platform lbl) cconv hresults hargs + pprCall platform (pprCLabel platform CStyle 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 (pprCLabel_ViaC platform lbl) cconv hresults hargs + pprForeignCall platform (pprCLabel platform CStyle 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 '&' <> pprCLabel_ViaC platform lbl + pprCLabelAddr lbl = char '&' <> pprCLabel platform CStyle 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, pprCLabel_ViaC platform lbl, text ");" + hcat [ visibility, label_type lbl , lparen, pprCLabel platform CStyle 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 " <> pprCLabel_ViaC platform lbl + text "extern __attribute__((stdcall)) void " <> pprCLabel platform CStyle lbl <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform)))) <> semi ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -435,7 +435,7 @@ renderLlvm sdoc = do -- Write to output dflags <- getDynFlags out <- getEnv envOutput - let ctx = initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle) + let ctx = initSDocContext dflags (Outp.PprCode Outp.CStyle) liftIO $ Outp.bufLeftRenderSDoc ctx out sdoc -- Dump, if requested @@ -497,9 +497,9 @@ strCLabel_llvm :: CLabel -> LlvmM LMString strCLabel_llvm lbl = do dflags <- getDynFlags platform <- getPlatform - let sdoc = pprCLabel_LLVM platform lbl + let sdoc = pprCLabel platform CStyle lbl str = Outp.renderWithContext - (initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle)) + (initSDocContext dflags (Outp.PprCode Outp.CStyle)) sdoc return (fsLit str) ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -1565,7 +1565,7 @@ genMachOp_slow opt op [x, y] = case op of else do -- Error. Continue anyway so we can debug the generated ll file. dflags <- getDynFlags - let style = mkCodeStyle CStyle + let style = PprCode CStyle toString doc = renderWithContext (initSDocContext dflags style) doc cmmToStr = (lines . toString . PprCmm.pprExpr platform) statement $ Comment $ map fsLit $ cmmToStr x ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -240,7 +240,6 @@ import GHC.Unit.Home import GHC.Unit.Types import GHC.Unit.Parser import GHC.Unit.Module -import GHC.Driver.Ppr import {-# SOURCE #-} GHC.Driver.Plugins import {-# SOURCE #-} GHC.Driver.Hooks import GHC.Builtin.Names ( mAIN ) @@ -1384,11 +1383,12 @@ jsonLogAction :: LogAction jsonLogAction dflags reason severity srcSpan msg = do defaultLogActionHPutStrDoc dflags stdout - (withPprStyle (mkCodeStyle CStyle) (doc $$ text "")) + (withPprStyle (PprCode CStyle) (doc $$ text "")) where + str = renderWithContext (initSDocContext dflags defaultUserStyle) msg doc = renderJSON $ JSObject [ ( "span", json srcSpan ) - , ( "doc" , JSString (showSDoc dflags msg) ) + , ( "doc" , JSString str ) , ( "severity", json severity ) , ( "reason" , json reason ) ] @@ -1990,8 +1990,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do = runCmdLine (processArgs activeFlags args) dflags0 -- See Note [Handling errors when parsing commandline flags] + let rdr = renderWithContext (initSDocContext dflags0 defaultUserStyle) unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $ - map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs + map ((rdr . ppr . getLoc &&& unLoc) . errMsg) $ errs -- check for disabled flags in safe haskell let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1 @@ -5094,7 +5095,6 @@ initSDocContext dflags style = SDC , sdocLinearTypes = xopt LangExt.LinearTypes dflags , sdocPrintTypeAbbreviations = True , sdocUnitIdForUser = ftext - , sdocDynFlags = dflags } -- | Initialize the pretty-printing options using the default user style ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -1334,8 +1334,7 @@ hpcInitCode dflags this_mod (HpcInfo tickCount hashNo) ] where platform = targetPlatform dflags - bcknd = backend dflags - tickboxes = pprCLabel bcknd platform (mkHpcTicksLabel $ this_mod) + tickboxes = pprCLabel platform CStyle (mkHpcTicksLabel $ this_mod) module_name = hcat (map (text.charToC) $ BS.unpack $ bytesFS (moduleNameFS (moduleName this_mod))) ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -51,7 +51,7 @@ module GHC.Utils.Outputable ( -- * Converting 'SDoc' into strings and outputting it printSDoc, printSDocLn, bufLeftRenderSDoc, - pprCode, mkCodeStyle, + pprCode, showSDocOneLine, renderWithContext, @@ -68,14 +68,14 @@ module GHC.Utils.Outputable ( -- * Controlling the style in which output is printed BindingSite(..), - PprStyle(..), CodeStyle(..), PrintUnqualified(..), + PprStyle(..), LabelStyle(..), PrintUnqualified(..), QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, reallyAlwaysQualify, reallyAlwaysQualifyNames, alwaysQualify, alwaysQualifyNames, alwaysQualifyModules, neverQualify, neverQualifyNames, neverQualifyModules, alwaysQualifyPackages, neverQualifyPackages, QualifyName(..), queryQual, - sdocWithDynFlags, sdocOption, + sdocOption, updSDocContext, SDocContext (..), sdocWithContext, defaultSDocContext, getPprStyle, withPprStyle, setStyleColoured, @@ -92,7 +92,6 @@ module GHC.Utils.Outputable ( import GHC.Prelude -import {-# SOURCE #-} GHC.Driver.Session ( DynFlags ) import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName ) import {-# SOURCE #-} GHC.Unit.Module.Name( ModuleName ) import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName ) @@ -150,11 +149,20 @@ data PprStyle -- Does not assume tidied code: non-external names -- are printed with uniques. - | PprCode CodeStyle - -- Print code; either C or assembler + | PprCode LabelStyle -- ^ Print code; either C or assembler -data CodeStyle = CStyle -- The format of labels differs for C and assembler - | AsmStyle +-- | Style of label pretty-printing. +-- +-- When we produce C sources or headers, we have to take into account that C +-- compilers transform C labels when they convert them into symbols. For +-- example, they can add prefixes (e.g., "_" on Darwin) or suffixes (size for +-- stdcalls on Windows). So we provide two ways to pretty-print CLabels: C style +-- or Asm style. +-- +data LabelStyle + = CStyle -- ^ C label style (used by C and LLVM backends) + | AsmStyle -- ^ Asm label style (used by NCG backend) + deriving (Eq,Ord,Show) data Depth = AllTheWay @@ -375,8 +383,6 @@ data SDocContext = SDC -- -- Note that we use `FastString` instead of `UnitId` to avoid boring -- module inter-dependency issues. - - , sdocDynFlags :: DynFlags -- TODO: remove (see Note [The OutputableP class]) } instance IsString SDoc where @@ -424,7 +430,6 @@ defaultSDocContext = SDC , sdocLinearTypes = False , sdocPrintTypeAbbreviations = True , sdocUnitIdForUser = ftext - , sdocDynFlags = error "defaultSDocContext: DynFlags not available" } withPprStyle :: PprStyle -> SDoc -> SDoc @@ -472,9 +477,6 @@ pprSetDepth depth doc = SDoc $ \ctx -> getPprStyle :: (PprStyle -> SDoc) -> SDoc getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx -sdocWithDynFlags :: (DynFlags -> SDoc) -> SDoc -sdocWithDynFlags f = SDoc $ \ctx -> runSDoc (f (sdocDynFlags ctx)) ctx - sdocWithContext :: (SDocContext -> SDoc) -> SDoc sdocWithContext f = SDoc $ \ctx -> runSDoc (f ctx) ctx @@ -556,12 +558,9 @@ bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO () bufLeftRenderSDoc ctx bufHandle doc = Pretty.bufLeftRender bufHandle (runSDoc doc ctx) -pprCode :: CodeStyle -> SDoc -> SDoc +pprCode :: LabelStyle -> SDoc -> SDoc pprCode cs d = withPprStyle (PprCode cs) d -mkCodeStyle :: CodeStyle -> PprStyle -mkCodeStyle = PprCode - renderWithContext :: SDocContext -> SDoc -> String renderWithContext ctx sdoc = let s = Pretty.style{ Pretty.mode = PageMode, @@ -966,9 +965,7 @@ instance Outputable Extension where -- * selected backend: to display CLabel as C labels or Asm labels -- -- In fact the whole compiler session state that is DynFlags was passed in --- SDocContext and these values were retrieved from it. (At the time of writing, --- a DynFlags field is still present into SDocContext but hopefully it shouldn't --- last long). +-- SDocContext and these values were retrieved from it. -- -- The Outputable class makes SDoc creation easy for many values by providing -- the ppr method: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7385f7077c6258c2a76ae51b4ea80f6fa9c7015...a997fa01d907fc1992dc8c3ebc73f98e7a1486f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7385f7077c6258c2a76ae51b4ea80f6fa9c7015...a997fa01d907fc1992dc8c3ebc73f98e7a1486f7 You're receiving 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 24 00:44:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 20:44:31 -0400 Subject: [Git][ghc/ghc][master] Remove redundant "do", "return" and language extensions from base Message-ID: <5f6bebef9c1eb_80b3f84431019d414043250@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 30 changed files: - libraries/base/.hlint.yaml - libraries/base/Control/Concurrent/Chan.hs - libraries/base/Control/Concurrent/QSem.hs - libraries/base/Control/Concurrent/QSemN.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/Data/String.hs - libraries/base/Debug/Trace.hs - libraries/base/Foreign/Marshal/Array.hs - libraries/base/Foreign/Marshal/Utils.hs - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/Environment.hs - libraries/base/GHC/Event/Array.hs - libraries/base/GHC/Event/Control.hs - libraries/base/GHC/Event/Manager.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/Fingerprint.hs - libraries/base/GHC/IO/Buffer.hs - libraries/base/GHC/IO/Encoding/Failure.hs - libraries/base/GHC/IO/Encoding/Iconv.hs - libraries/base/GHC/IO/FD.hs - libraries/base/GHC/IO/Handle.hs - libraries/base/GHC/IO/Handle/Internals.hs - libraries/base/GHC/IO/Handle/Text.hs - libraries/base/GHC/TypeLits.hs - libraries/base/System/IO.hs - libraries/base/System/Posix/Internals.hs - libraries/base/Text/ParserCombinators/ReadP.hs - libraries/base/Text/Printf.hs - libraries/base/Text/Read/Lex.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31fea307499009977fdf3dadedc98cfef986077a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/31fea307499009977fdf3dadedc98cfef986077a You're receiving 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 24 00:46:45 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 23 Sep 2020 20:46:45 -0400 Subject: [Git][ghc/ghc][wip/T16762] Push through some Haddock changes, disable warnings in GHC.Iface.Ext.Ast for now Message-ID: <5f6bec7510cb4_80b111bf7f41404463f@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 832a27d1 by Ryan Scott at 2020-09-23T20:41:02-04:00 Push through some Haddock changes, disable warnings in GHC.Iface.Ext.Ast for now - - - - - 2 changed files: - compiler/GHC/Iface/Ext/Ast.hs - utils/haddock Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -19,6 +19,10 @@ Main functions for .hie file generation {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +-- TODO RGS: This is a horrible hack that I put in place to get the test suite +-- to run on GitLab CI. Please remove this hack before landing! +{-# OPTIONS_GHC -Wno-unused-matches -Wno-unused-local-binds #-} + module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where import GHC.Utils.Outputable(ppr) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 8c8517d6c82411212452c3c5fca503c7af5ac3da +Subproject commit 856de40b212c44cb0894629184c3b62d87fdc260 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/832a27d190f53a8135bb21cce32dc6bdd7e57fdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/832a27d190f53a8135bb21cce32dc6bdd7e57fdb You're receiving 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 24 01:15:19 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 23 Sep 2020 21:15:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Refactor CLabel pretty-printing Message-ID: <5f6bf327ed169_80b3f84866d8f041405116f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 21215e70 by syd at cs-syd.eu at 2020-09-23T21:15:10-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - f8aa5775 by Simon Peyton Jones at 2020-09-23T21:15:11-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 039be784 by Simon Peyton Jones at 2020-09-23T21:15:11-04: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 - - - - - 7eccfa62 by Sebastian Graf at 2020-09-23T21:15:11-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - e7786d6f by Hécate at 2020-09-23T21:15:12-04:00 Namespace the Hadrian linting rule for base - - - - - 26 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.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/HsToCore/PmCheck/Types.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab2fd7c08065b5faac0773a3432fdf00ca217696...e7786d6f704f6fe0156cc07cc9c1c072c5c76a20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab2fd7c08065b5faac0773a3432fdf00ca217696...e7786d6f704f6fe0156cc07cc9c1c072c5c76a20 You're receiving 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 24 06:45:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 02:45:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f6c4090ae575_80b3f848679255814071026@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cbd853af by syd at cs-syd.eu at 2020-09-24T02:45:26-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 5d81a9b8 by Simon Peyton Jones at 2020-09-24T02:45:27-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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) - - - - - 2ef18ab4 by Simon Peyton Jones at 2020-09-24T02:45:27-04: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 - - - - - 269c7efb by Sebastian Graf at 2020-09-24T02:45:27-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 0420e7ec by Hécate at 2020-09-24T02:45:29-04:00 Namespace the Hadrian linting rule for base - - - - - 20 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/HsToCore/PmCheck/Types.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/e7786d6f704f6fe0156cc07cc9c1c072c5c76a20...0420e7ec0b6602fcc3866e35bd63419cb2ac19d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7786d6f704f6fe0156cc07cc9c1c072c5c76a20...0420e7ec0b6602fcc3866e35bd63419cb2ac19d8 You're receiving 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 24 07:22:58 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 24 Sep 2020 03:22:58 -0400 Subject: [Git][ghc/ghc][wip/T18126] 8 commits: Remove the list of loaded modules from the ghci prompt Message-ID: <5f6c49526cd00_80b3f84877fc77c14075254@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - b83009b1 by Simon Peyton Jones at 2020-09-24T08:22:01+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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 89831ac8 by Simon Peyton Jones at 2020-09-24T08:22:36+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 - - - - - 25 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cca982e8fc2ab6e99c6e21b4db56f938f5e5c55d...89831ac862914568a77fbdcb82b616af49e1b994 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cca982e8fc2ab6e99c6e21b4db56f938f5e5c55d...89831ac862914568a77fbdcb82b616af49e1b994 You're receiving 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 24 08:40:52 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 24 Sep 2020 04:40:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-9.0-runpath-backport Message-ID: <5f6c5b9448045_80b3f8495a765941408048a@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-9.0-runpath-backport at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-9.0-runpath-backport You're receiving 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 24 09:31:14 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 24 Sep 2020 05:31:14 -0400 Subject: [Git][ghc/ghc][wip/T18371] 3 commits: Add regression tests for #18371 Message-ID: <5f6c676218a3b_80b3f8487908d64140884dc@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18371 at Glasgow Haskell Compiler / GHC Commits: 00190df0 by Sebastian Graf at 2020-09-24T11:31:06+02:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - b008d972 by Sebastian Graf at 2020-09-24T11:31:06+02:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - b6bd12cf by Sebastian Graf at 2020-09-24T11:31:06+02:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 6 changed files: - testsuite/tests/pmcheck/should_compile/T17218.stderr - + testsuite/tests/pmcheck/should_compile/T18371.hs - + testsuite/tests/pmcheck/should_compile/T18371b.hs - + testsuite/tests/pmcheck/should_compile/T18609.hs - + testsuite/tests/pmcheck/should_compile/T18609.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== testsuite/tests/pmcheck/should_compile/T17218.stderr ===================================== @@ -1,6 +1,4 @@ T17218.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In an equation for ‘f’: - Patterns not matched: - C + In an equation for ‘f’: Patterns not matched: P ===================================== testsuite/tests/pmcheck/should_compile/T18371.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module Bug where + +import Data.Kind +import Unsafe.Coerce + +type family Sing :: k -> Type + +class SingI a where + sing :: Sing a + +data SingInstance :: forall k. k -> Type where + SingInstance :: SingI a => SingInstance a + +newtype DI (a :: k) = Don'tInstantiate (SingI a => SingInstance a) + +singInstance :: forall k (a :: k). Sing a -> SingInstance a +singInstance s = with_sing_i SingInstance + where + with_sing_i :: (SingI a => SingInstance a) -> SingInstance a + with_sing_i si = unsafeCoerce (Don'tInstantiate si) s + +{-# COMPLETE Sing #-} +pattern Sing :: forall k (a :: k). () => SingI a => Sing a +pattern Sing <- (singInstance -> SingInstance) + where Sing = sing + +----- + +data SBool :: Bool -> Type where + SFalse :: SBool False + STrue :: SBool True +type instance Sing = SBool + +f :: SBool b -> () +f Sing = () + +g :: Sing (b :: Bool) -> () +g Sing = () ===================================== testsuite/tests/pmcheck/should_compile/T18371b.hs ===================================== @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +module Lib where + +type family T + +pattern P :: T +pattern P <- _ +{-# COMPLETE P #-} + +data U = U +type instance T = U + +f :: U -> () +f P = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns, GADTs, DataKinds, KindSignatures, EmptyCase #-} + +-- | All examples from https://arxiv.org/abs/1702.02281 +module GarrigueLeNormand where + +import Data.Kind + +data N = Z | S N + +data Plus :: N -> N -> N -> Type where + PlusO :: Plus Z a a + PlusS :: !(Plus a b c) -> Plus (S a) b (S c) + +data SMaybe a = SJust !a | SNothing + +trivial :: SMaybe (Plus (S Z) Z Z) -> () +trivial SNothing = () + +trivial2 :: Plus (S Z) Z Z -> () +trivial2 x = case x of {} + +easy :: SMaybe (Plus Z (S Z) Z) -> () +easy SNothing = () + +easy2 :: Plus Z (S Z) Z -> () +easy2 x = case x of {} + +harder :: SMaybe (Plus (S Z) (S Z) (S Z)) -> () +harder SNothing = () + +harder2 :: Plus (S Z) (S Z) (S Z) -> () +harder2 x = case x of {} + +invZero :: Plus a b c -> Plus c d Z -> () +invZero !_ !_ | False = () +invZero PlusO PlusO = () + +data T a where + A :: T Int + B :: T Bool + C :: T Char + D :: T Float + +data U a b c d where + U :: U Int Int Int Int + +f :: T a -> T b -> T c -> T d + -> U a b c d + -> () +f !_ !_ !_ !_ !_ | False = () +f A A A A U = () + +g :: T a -> T b -> T c -> T d + -> T e -> T f -> T g -> T h + -> U a b c d + -> U e f g h + -> () +g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = () +g A A A A A A A A U U = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.stderr ===================================== @@ -0,0 +1,13 @@ + +T18609.hs:36:25: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘invZero’: invZero !_ !_ | False = ... + +T18609.hs:51:20: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !_ !_ !_ !_ !_ | False = ... + +T18609.hs:59:35: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: + g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -96,7 +96,7 @@ test('T17215', expect_broken(17215), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17216', expect_broken(17216), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17218', expect_broken(17218), compile, +test('T17218', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17219', expect_broken(17219), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) @@ -140,12 +140,18 @@ test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371b', 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('T18609', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ab474b3fada3030bee7fc77026b90e234826658...b6bd12cf75dbe0d8ff698d6d8678fc6848643c1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5ab474b3fada3030bee7fc77026b90e234826658...b6bd12cf75dbe0d8ff698d6d8678fc6848643c1f You're receiving 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 24 12:15:54 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 08:15:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f6c8dfa2b57a_80b3f849c2775bc14127022@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8216f891 by syd at cs-syd.eu at 2020-09-24T08:15:44-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - fcc9aab3 by Simon Peyton Jones at 2020-09-24T08:15:45-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 00080feb by Simon Peyton Jones at 2020-09-24T08:15:45-04: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 - - - - - 107abe51 by Sebastian Graf at 2020-09-24T08:15:45-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - f9a1bc72 by Hécate at 2020-09-24T08:15:46-04:00 Namespace the Hadrian linting rule for base - - - - - 20 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/HsToCore/PmCheck/Types.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/0420e7ec0b6602fcc3866e35bd63419cb2ac19d8...f9a1bc7252a671dac36a69130ae309b5006703a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0420e7ec0b6602fcc3866e35bd63419cb2ac19d8...f9a1bc7252a671dac36a69130ae309b5006703a4 You're receiving 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 24 13:35:55 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Thu, 24 Sep 2020 09:35:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-18740-lookup-update Message-ID: <5f6ca0bb67c53_80b3f849027fd7c141349b9@gitlab.haskell.org.mail> Danya Rogozin pushed new branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-18740-lookup-update You're receiving 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 24 13:42:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 09:42:34 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 2 commits: Bump Cabal, directory, process submodules Message-ID: <5f6ca24a4023a_80b3f8494cea38014137350@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 5c20b328 by Ben Gamari at 2020-09-24T09:42:07-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 102b1728 by Ben Gamari at 2020-09-24T09:42:22-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6 changed files: - libraries/Cabal - libraries/directory - libraries/process - testsuite/tests/driver/all.T - utils/ghc-cabal/ghc.mk - utils/hsc2hs Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit e4be83379c1299bd254654a8666744b3668fd96f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', ignore_stdout, makefile_test, []) +test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== utils/ghc-cabal/ghc.mk ===================================== @@ -38,20 +38,20 @@ $(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/. "$(CP)" $< $@ # Minor hack, since we can't reuse the `hs-suffix-rules-srcdir` macro -ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Fields/Lexer.x),) +ifneq ($(wildcard libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.x),) # Lexer.x exists so we have to call Alex ourselves CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Fields/Lexer.hs -bootstrapping/Cabal/Distribution/Fields/Lexer.hs: libraries/Cabal/Cabal/Distribution/Fields/Lexer.x +bootstrapping/Cabal/Distribution/Fields/Lexer.hs: libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.x mkdir -p bootstrapping/Cabal/Distribution/Fields $(call cmd,ALEX) $< -o $@ else -CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Fields/Lexer.hs +CABAL_LEXER_DEP := libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.hs endif -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs) -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs) -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*/*/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*.hs) # N.B. Compile with -O0 since this is not a performance-critical executable # and the Cabal takes nearly twice as long to build with -O1. See #16817. @@ -70,7 +70,7 @@ $(ghc-cabal_DIST_BINARY): $(CABAL_LEXER_DEP) utils/ghc-cabal/Main.hs $(TOUCH_DEP -odir bootstrapping \ -hidir bootstrapping \ $(CABAL_LEXER_DEP) \ - -ilibraries/Cabal/Cabal \ + -ilibraries/Cabal/Cabal/src \ -ilibraries/binary/src \ -ilibraries/filepath \ -ilibraries/hpc \ ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 4171a459e9d66ebf71d92368be3d7f55cca3e7e1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b752ea76212ee92d760516efbf515c2cac41776...102b172828855545732f7b1348fb9660f8a724bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b752ea76212ee92d760516efbf515c2cac41776...102b172828855545732f7b1348fb9660f8a724bd You're receiving 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 24 15:36:50 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Thu, 24 Sep 2020 11:36:50 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 4 commits: Correct RtsAPI documentation Message-ID: <5f6cbd12a7ad4_80b3f8459e77a58141629d5@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 961bc95a by David Eichmann at 2020-09-24T11:00:38+01:00 Correct RtsAPI documentation - - - - - 21148cfb by David Eichmann at 2020-09-24T11:01:23+01:00 Remove transformers dependency from ghc-heap - - - - - fd03589e by David Eichmann at 2020-09-24T12:53:02+01:00 Move ptrToInt to GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled - - - - - 8e097c8e by David Eichmann at 2020-09-24T15:29:13+01:00 Simplify getClosureDataX and rename to getClosureDataWith - - - - - 6 changed files: - includes/RtsAPI.h - libraries/ghc-heap/GHC/Exts/Heap.hs - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs - − libraries/ghc-heap/GHC/Exts/Heap/Ptr/Utils.hs - libraries/ghc-heap/ghc-heap.cabal.in Changes: ===================================== includes/RtsAPI.h ===================================== @@ -340,7 +340,8 @@ extern void (*exitFn)(int); ------------------------------------------------------------------------- */ // acquires a token which may be used to create new objects and evaluate them. -// Calling rts_lock in between rts_pause/rts_resume will cause a deadlock. +// Calling rts_lock in between rts_pause/rts_resume on the same thread will +// cause an error. Capability *rts_lock (void); // releases the token acquired with rts_lock(). @@ -494,8 +495,8 @@ SchedulerStatus rts_getSchedStatus (Capability *cap); // thread, then rts_pause will return immediately and have no effect. Returns a // token which may be used to create new objects and evaluate them (like // rts_lock) .This is different to rts_lock which only pauses a single -// capability. Calling rts_pause in between rts_lock/rts_unlock will cause a -// deadlock. +// capability. Calling rts_pause in between rts_lock/rts_unlock on the same +// thread will cause an error. Capability * rts_pause (void); // Counterpart of rts_pause: Continue from a pause. All capabilities are ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -31,7 +31,7 @@ module GHC.Exts.Heap ( , WhatNext(..) , WhyBlocked(..) , TsoFlags(..) - , HasHeapRep(getClosureDataX) + , HasHeapRep(getClosureDataWith) , getClosureData -- * Info Table types @@ -83,7 +83,6 @@ import qualified GHC.Exts.Heap.FFIClosures as FFIClosures import Control.Monad import Data.Bits -import GHC.Arr import GHC.Exts import GHC.Int import GHC.Word @@ -102,64 +101,65 @@ class HasHeapRep (a :: TYPE rep) where -- | Decode a closure to it's heap representation ('GenClosure'). -- Inside a GHC context 'b' is usually a 'GHC.Exts.Heap.Closures.Box' - -- containing a thunk or an evaluated heap object. Outside it can be a - -- 'Word' for "raw" usage of pointers. + -- containing a thunk or an evaluated heap object. Outside it can be e.g. + -- a 'Word' for "raw" usage of pointers. - getClosureDataX :: - (forall c . c -> IO (Ptr StgInfoTable, [Word], [b])) - -- ^ Helper function to get info table, memory and pointers of the - -- closure. The order of @[b]@ is significant and determined by - -- @collect_pointers()@ in @rts/Heap.c at . - -> a -- ^ Closure to decode - -> IO (GenClosure b) -- ^ Heap representation of the closure + getClosureDataWith :: + (forall c . c -> b) + -- ^ Convert any closure to some pointer type. + -> a + -- ^ Closure to decode. + -> IO (GenClosure b) + -- ^ Heap representation of the closure. instance HasHeapRep (a :: TYPE 'LiftedRep) where - getClosureDataX = getClosureX + getClosureDataWith = getClosureWith instance HasHeapRep (a :: TYPE 'UnliftedRep) where - getClosureDataX k x = getClosureX (k . unsafeCoerce#) (unsafeCoerce# x) + getClosureDataWith k x = getClosureWith (k . unsafeCoerce#) (unsafeCoerce# x) instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ IntClosure { ptipe = PInt, intVal = I# x } instance Word# ~ a => HasHeapRep (a :: TYPE 'WordRep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ WordClosure { ptipe = PWord, wordVal = W# x } instance Int64# ~ a => HasHeapRep (a :: TYPE 'Int64Rep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ Int64Closure { ptipe = PInt64, int64Val = I64# (unsafeCoerce# x) } instance Word64# ~ a => HasHeapRep (a :: TYPE 'Word64Rep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ Word64Closure { ptipe = PWord64, word64Val = W64# (unsafeCoerce# x) } instance Addr# ~ a => HasHeapRep (a :: TYPE 'AddrRep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ AddrClosure { ptipe = PAddr, addrVal = I# (unsafeCoerce# x) } instance Float# ~ a => HasHeapRep (a :: TYPE 'FloatRep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ FloatClosure { ptipe = PFloat, floatVal = F# x } instance Double# ~ a => HasHeapRep (a :: TYPE 'DoubleRep) where - getClosureDataX _ x = return $ + getClosureDataWith _ x = return $ DoubleClosure { ptipe = PDouble, doubleVal = D# x } --- From GHC.Runtime.Heap.Inspect -amap' :: (t -> b) -> Array Int t -> [b] -amap' f (Array i0 i _ arr#) = map g [0 .. i - i0] - where g (I# i#) = case indexArray# arr# i# of - (# e #) -> f e - --- | Takes any value (closure) as parameter and returns a tuple of: --- * A 'Ptr' to the info table --- * The memory of the closure as @[Word]@ --- * Pointers of the closure's @struct@ (in C code) in a @[Box]@. --- The pointers are collected in @Heap.c at . -getClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box]) -getClosureRaw x = do +-- | Deconstruct any closure's heap representation. +getClosureRaw + :: (forall c . c -> b) + -- ^ Convert any closure to some pointer type. + -> a + -- ^ Closure to deconstruct. + -> IO (Ptr StgInfoTable, [Word], [b]) + -- ^ Tuple of: + -- * A 'Ptr' to the info table + -- * Non-pointer data of the closure. + -- * Pointer data of the closure. These are the closures pointed to by the + -- input closure, boxed with the given function. The pointers are + -- collected in @Heap.c at . +getClosureRaw asBoxish x = do case unpackClosure# x of -- This is a hack to cover the bootstrap compiler using the old version of -- 'unpackClosure'. The new 'unpackClosure' return values are not merely @@ -172,37 +172,29 @@ getClosureRaw x = do let nelems = (I# (sizeofByteArray# dat)) `div` wORD_SIZE end = fromIntegral nelems - 1 rawWds = [W# (indexWordArray# dat i) | I# i <- [0.. end] ] - pelems = I# (sizeofArray# pointers) - ptrList = amap' Box $ Array 0 (pelems - 1) pelems pointers + ptrList = [case indexArray# pointers i of (# ptr #) -> asBoxish ptr + | I# i <- [0..(I# (sizeofArray# pointers)) - 1] + ] pure (Ptr iptr, rawWds, ptrList) getClosureData :: forall rep (a :: TYPE rep) . HasHeapRep a => a -> IO Closure -getClosureData = getClosureDataX getClosureRaw +getClosureData = getClosureDataWith asBox - --- | This function returns a parsed heap representation ('GenClosure') of the --- closure _at this moment_, even if it is unevaluated or an indirection or --- other exotic stuff. Beware when passing something to this function, the same --- caveats as for 'asBox' apply. --- --- Inside a GHC context 'b' is usually a 'GHC.Exts.Heap.Closures.Box' --- containing a thunk or an evaluated heap object. Outside it can be a --- 'Word' for "raw" usage of pointers. --- --- 'get_closure_raw' should provide low level details of the closure's heap --- respresentation. The order of @[b]@ is significant and determined by --- @collect_pointers()@ in @rts/Heap.c at . +-- | Get the heap representation of a closure _at this moment_, even if it is +-- unevaluated or an indirection or other exotic stuff. Beware when passing +-- something to this function, the same caveats as for +-- 'GHC.Exts.Heap.Closures.asBox' apply. -- -- For most use cases 'getClosureData' is an easier to use alternative. - -getClosureX :: forall a b. - (forall c . c -> IO (Ptr StgInfoTable, [Word], [b])) - -- ^ Helper function to get info table, memory and pointers of the - -- closure - -> a -- ^ Closure to decode - -> IO (GenClosure b) -- ^ Heap representation of the closure -getClosureX get_closure_raw x = do - (iptr, wds, pts) <- get_closure_raw (unsafeCoerce# x) +getClosureWith :: forall a b. + (forall c . c -> b) + -- ^ Convert any closure to some pointer type. + -> a + -- ^ Closure to decode. + -> IO (GenClosure b) + -- ^ Heap representation of the closure. +getClosureWith asBoxish x = do + (iptr, wds, pts) <- getClosureRaw asBoxish (unsafeCoerce# x) itbl <- peekItbl iptr -- The remaining words after the header let rawWds = drop (closureTypeHeaderSize (tipe itbl)) wds @@ -391,6 +383,6 @@ getClosureX get_closure_raw x = do _ -> pure $ UnsupportedClosure itbl --- | Like 'getClosureDataX', but taking a 'Box', so it is easier to work with. +-- | Like 'getClosureDataWith', but taking a 'Box', so it is easier to work with. getBoxedClosureData :: Box -> IO Closure getBoxedClosureData (Box a) = getClosureData a ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc ===================================== @@ -1,4 +1,7 @@ -{-# LANGUAGE CPP, DeriveGeneric #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MagicHash #-} + module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled( peekStgTSOProfInfo ) where @@ -17,37 +20,27 @@ module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled( #undef BLOCKS_PER_MBLOCK #include "DerivedConstants.h" -import Prelude -import Foreign - -import Foreign.C.String -import GHC.Exts.Heap.ProfInfo.Types - -import Data.IntMap.Strict (IntMap) -import qualified Data.IntMap.Strict as IntMap - -import Data.IntSet (IntSet) +import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet - -import Control.Monad.Trans.State -import Control.Monad.IO.Class - -import GHC.Exts.Heap.Ptr.Utils +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IntMap +import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Foreign +import Foreign.C.String +import GHC.Exts +import GHC.Exts.Heap.ProfInfo.Types +import Prelude -- Use Int based containers for pointers (addresses) for better performance. -- These will be queried a lot! type AddressSet = IntSet type AddressMap = IntMap -data Cache = Cache { - ccCache :: AddressMap CostCentre -} -type DecoderMonad a = StateT Cache IO a - peekStgTSOProfInfo :: Ptr a -> IO (Maybe StgTSOProfInfo) peekStgTSOProfInfo tsoPtr = do cccs_ptr <- peekByteOff tsoPtr cccsOffset - cccs' <- evalStateT (peekCostCentreStack IntSet.empty cccs_ptr) $ Cache IntMap.empty + costCenterCacheRef <- newIORef IntMap.empty + cccs' <- peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr return $ Just StgTSOProfInfo { cccs = cccs' @@ -56,27 +49,27 @@ peekStgTSOProfInfo tsoPtr = do cccsOffset :: Int cccsOffset = (#const OFFSET_StgTSO_cccs) + (#size StgHeader) -peekCostCentreStack :: AddressSet -> Ptr costCentreStack -> DecoderMonad (Maybe CostCentreStack) -peekCostCentreStack _ ptr | ptr == nullPtr = return Nothing -peekCostCentreStack loopBreakers ptr | IntSet.member (ptrToInt ptr) loopBreakers = return Nothing -peekCostCentreStack loopBreakers ptr = do - ccs_ccsID' <- liftIO $ (#peek struct CostCentreStack_, ccsID) ptr - ccs_cc_ptr <- liftIO $ (#peek struct CostCentreStack_, cc) ptr - ccs_cc' <- peekCostCentre ccs_cc_ptr - ccs_prevStack_ptr <- liftIO $ (#peek struct CostCentreStack_, prevStack) ptr +peekCostCentreStack :: AddressSet -> IORef (AddressMap CostCentre) -> Ptr costCentreStack -> IO (Maybe CostCentreStack) +peekCostCentreStack _ _ ptr | ptr == nullPtr = return Nothing +peekCostCentreStack loopBreakers _ ptr | IntSet.member (ptrToInt ptr) loopBreakers = return Nothing +peekCostCentreStack loopBreakers costCenterCacheRef ptr = do + ccs_ccsID' <- (#peek struct CostCentreStack_, ccsID) ptr + ccs_cc_ptr <- (#peek struct CostCentreStack_, cc) ptr + ccs_cc' <- peekCostCentre costCenterCacheRef ccs_cc_ptr + ccs_prevStack_ptr <- (#peek struct CostCentreStack_, prevStack) ptr let loopBreakers' = (IntSet.insert ptrAsInt loopBreakers) - ccs_prevStack' <- peekCostCentreStack loopBreakers' ccs_prevStack_ptr - ccs_indexTable_ptr <- liftIO $ (#peek struct CostCentreStack_, indexTable) ptr - ccs_indexTable' <- peekIndexTable loopBreakers' ccs_indexTable_ptr - ccs_root_ptr <- liftIO $ (#peek struct CostCentreStack_, root) ptr - ccs_root' <- peekCostCentreStack loopBreakers' ccs_root_ptr - ccs_depth' <- liftIO $ (#peek struct CostCentreStack_, depth) ptr - ccs_scc_count' <- liftIO $ (#peek struct CostCentreStack_, scc_count) ptr - ccs_selected' <- liftIO $ (#peek struct CostCentreStack_, selected) ptr - ccs_time_ticks' <- liftIO $ (#peek struct CostCentreStack_, time_ticks) ptr - ccs_mem_alloc' <- liftIO $ (#peek struct CostCentreStack_, mem_alloc) ptr - ccs_inherited_alloc' <- liftIO $ (#peek struct CostCentreStack_, inherited_alloc) ptr - ccs_inherited_ticks' <- liftIO $ (#peek struct CostCentreStack_, inherited_ticks) ptr + ccs_prevStack' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_prevStack_ptr + ccs_indexTable_ptr <- (#peek struct CostCentreStack_, indexTable) ptr + ccs_indexTable' <- peekIndexTable loopBreakers' costCenterCacheRef ccs_indexTable_ptr + ccs_root_ptr <- (#peek struct CostCentreStack_, root) ptr + ccs_root' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_root_ptr + ccs_depth' <- (#peek struct CostCentreStack_, depth) ptr + ccs_scc_count' <- (#peek struct CostCentreStack_, scc_count) ptr + ccs_selected' <- (#peek struct CostCentreStack_, selected) ptr + ccs_time_ticks' <- (#peek struct CostCentreStack_, time_ticks) ptr + ccs_mem_alloc' <- (#peek struct CostCentreStack_, mem_alloc) ptr + ccs_inherited_alloc' <- (#peek struct CostCentreStack_, inherited_alloc) ptr + ccs_inherited_ticks' <- (#peek struct CostCentreStack_, inherited_ticks) ptr return $ Just CostCentreStack { ccs_ccsID = ccs_ccsID', @@ -95,31 +88,31 @@ peekCostCentreStack loopBreakers ptr = do where ptrAsInt = ptrToInt ptr -peekCostCentre :: Ptr costCentre -> DecoderMonad CostCentre -peekCostCentre ptr = do - cache <- get - case IntMap.lookup ptrAsInt (ccCache cache) of +peekCostCentre :: IORef (AddressMap CostCentre) -> Ptr costCentre -> IO CostCentre +peekCostCentre costCenterCacheRef ptr = do + costCenterCache <- readIORef costCenterCacheRef + case IntMap.lookup ptrAsInt costCenterCache of (Just a) -> return a Nothing -> do - cc_ccID' <- liftIO $ (#peek struct CostCentre_, ccID) ptr - cc_label_ptr <- liftIO $ (#peek struct CostCentre_, label) ptr - cc_label' <- liftIO $ peekCString cc_label_ptr - cc_module_ptr <- liftIO $ (#peek struct CostCentre_, module) ptr - cc_module' <- liftIO $ peekCString cc_module_ptr - cc_srcloc_ptr <- liftIO $ (#peek struct CostCentre_, srcloc) ptr - cc_srcloc' <- liftIO $ do + cc_ccID' <- (#peek struct CostCentre_, ccID) ptr + cc_label_ptr <- (#peek struct CostCentre_, label) ptr + cc_label' <- peekCString cc_label_ptr + cc_module_ptr <- (#peek struct CostCentre_, module) ptr + cc_module' <- peekCString cc_module_ptr + cc_srcloc_ptr <- (#peek struct CostCentre_, srcloc) ptr + cc_srcloc' <- do if cc_srcloc_ptr == nullPtr then return Nothing else fmap Just (peekCString cc_srcloc_ptr) - cc_mem_alloc' <- liftIO $ (#peek struct CostCentre_, mem_alloc) ptr - cc_time_ticks' <- liftIO $ (#peek struct CostCentre_, time_ticks) ptr - cc_is_caf' <- liftIO $ (#peek struct CostCentre_, is_caf) ptr - cc_link_ptr <- liftIO $ (#peek struct CostCentre_, link) ptr + cc_mem_alloc' <- (#peek struct CostCentre_, mem_alloc) ptr + cc_time_ticks' <- (#peek struct CostCentre_, time_ticks) ptr + cc_is_caf' <- (#peek struct CostCentre_, is_caf) ptr + cc_link_ptr <- (#peek struct CostCentre_, link) ptr cc_link' <- if cc_link_ptr == nullPtr then return Nothing else - fmap Just (peekCostCentre cc_link_ptr) + fmap Just (peekCostCentre costCenterCacheRef cc_link_ptr) let result = CostCentre { cc_ccID = cc_ccID', @@ -132,23 +125,22 @@ peekCostCentre ptr = do cc_link = cc_link' } - let updatedCCCache = IntMap.insert ptrAsInt result (ccCache cache) - put $ cache { ccCache = updatedCCCache } + writeIORef costCenterCacheRef (IntMap.insert ptrAsInt result costCenterCache) return result where ptrAsInt = ptrToInt ptr -peekIndexTable :: AddressSet -> Ptr indexTable -> DecoderMonad (Maybe IndexTable) -peekIndexTable _ ptr | ptr == nullPtr = return Nothing -peekIndexTable loopBreakers ptr = do - it_cc_ptr <- liftIO $ (#peek struct IndexTable_, cc) ptr - it_cc' <- peekCostCentre it_cc_ptr - it_ccs_ptr <- liftIO $ (#peek struct IndexTable_, ccs) ptr - it_ccs' <- peekCostCentreStack loopBreakers it_ccs_ptr - it_next_ptr <- liftIO $ (#peek struct IndexTable_, next) ptr - it_next' <- peekIndexTable loopBreakers it_next_ptr - it_back_edge' <- liftIO $ (#peek struct IndexTable_, back_edge) ptr +peekIndexTable :: AddressSet -> IORef (AddressMap CostCentre) -> Ptr indexTable -> IO (Maybe IndexTable) +peekIndexTable _ _ ptr | ptr == nullPtr = return Nothing +peekIndexTable loopBreakers costCenterCacheRef ptr = do + it_cc_ptr <- (#peek struct IndexTable_, cc) ptr + it_cc' <- peekCostCentre costCenterCacheRef it_cc_ptr + it_ccs_ptr <- (#peek struct IndexTable_, ccs) ptr + it_ccs' <- peekCostCentreStack loopBreakers costCenterCacheRef it_ccs_ptr + it_next_ptr <- (#peek struct IndexTable_, next) ptr + it_next' <- peekIndexTable loopBreakers costCenterCacheRef it_next_ptr + it_back_edge' <- (#peek struct IndexTable_, back_edge) ptr return $ Just IndexTable { it_cc = it_cc', @@ -157,6 +149,10 @@ peekIndexTable loopBreakers ptr = do it_back_edge = it_back_edge' } +-- | casts a @Ptr@ to an @Int@ +ptrToInt :: Ptr a -> Int +ptrToInt (Ptr a##) = I## (addr2Int## a##) + #else import Prelude import Foreign ===================================== libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs ===================================== @@ -6,10 +6,16 @@ import Prelude import Data.Word import GHC.Generics +-- | This is a somewhat faithful representation of StgTSOProfInfo. See +-- +-- for more details on this data structure. data StgTSOProfInfo = StgTSOProfInfo { cccs :: Maybe CostCentreStack } deriving (Show, Generic) +-- | This is a somewhat faithful representation of CostCentreStack. See +-- +-- for more details on this data structure. data CostCentreStack = CostCentreStack { ccs_ccsID :: Int, ccs_cc :: CostCentre, @@ -25,6 +31,9 @@ data CostCentreStack = CostCentreStack { ccs_inherited_ticks :: Word } deriving (Show, Generic, Eq) +-- | This is a somewhat faithful representation of CostCentre. See +-- +-- for more details on this data structure. data CostCentre = CostCentre { cc_ccID :: Int, cc_label :: String, @@ -36,6 +45,9 @@ data CostCentre = CostCentre { cc_link :: Maybe CostCentre } deriving (Show, Generic, Eq) +-- | This is a somewhat faithful representation of IndexTable. See +-- +-- for more details on this data structure. data IndexTable = IndexTable { it_cc :: CostCentre, it_ccs :: Maybe CostCentreStack, ===================================== libraries/ghc-heap/GHC/Exts/Heap/Ptr/Utils.hs deleted ===================================== @@ -1,11 +0,0 @@ -{-# LANGUAGE CPP, DeriveGeneric, MagicHash #-} - -module GHC.Exts.Heap.Ptr.Utils where - -import Prelude -import GHC.Ptr -import GHC.Exts - --- | casts a @Ptr@ to an @Int@ -ptrToInt :: Ptr a -> Int -ptrToInt (Ptr a#) = I# (addr2Int# a#) ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -26,7 +26,6 @@ library , ghc-prim > 0.2 && < 0.8 , rts == 1.0.* , containers >= 0.6.2.1 && < 0.7 - , transformers == 0.5.* ghc-options: -Wall cmm-sources: cbits/HeapPrim.cmm @@ -45,4 +44,3 @@ library GHC.Exts.Heap.ProfInfo.Types GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled - GHC.Exts.Heap.Ptr.Utils View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d...8e097c8edfcae9c83f10d69af032d34fd2f950dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcd2bb45fa2cbd1de83a7d233d87d0655b4cca7d...8e097c8edfcae9c83f10d69af032d34fd2f950dc You're receiving 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 24 15:59:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 11:59:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/test-hadrian-stack-build Message-ID: <5f6cc26725255_80b3f84941963d0141703fc@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/test-hadrian-stack-build at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/test-hadrian-stack-build You're receiving 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 24 16:00:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 12:00:01 -0400 Subject: [Git][ghc/ghc][wip/test-hadrian-stack-build] gitlab-ci: Verify that Hadrian builds with Stack Message-ID: <5f6cc281acf67_80b3f83f21017001417057b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test-hadrian-stack-build at Glasgow Haskell Compiler / GHC Commits: 17f6d882 by Ben Gamari at 2020-09-24T11:59:55-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -234,6 +234,14 @@ lint-release-changelogs: tags: - x86_64-linux +stack-hadrian-build: + extends: .validate-linux-hadrian + script: + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - hadrian/build-stack --version + stage: build + validate-x86_64-linux-deb9-hadrian: extends: .validate-linux-hadrian stage: build View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17f6d882773970b27a02daccb838803a0c284186 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17f6d882773970b27a02daccb838803a0c284186 You're receiving 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 24 16:50:38 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 24 Sep 2020 12:50:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/refactor-pmc Message-ID: <5f6cce5e387b6_80b3f848648531014185271@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/refactor-pmc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/refactor-pmc You're receiving 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 24 17:14:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 13:14:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f6cd40f7b526_80b3f8486a2600814190578@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 Thu Sep 24 17:16:19 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 13:16:19 -0400 Subject: [Git][ghc/ghc][master] Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f6cd463b3420_80b3f8428386e0414196256@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 1 changed file: - libraries/base/GHC/IO/Handle/Lock.hs Changes: ===================================== libraries/base/GHC/IO/Handle/Lock.hs ===================================== @@ -52,6 +52,8 @@ hLock h mode = void $ lockImpl h "hLock" mode True -- | Non-blocking version of 'hLock'. -- +-- Returns 'True' if taking the lock was successful and 'False' otherwise. +-- -- @since 4.10.0.0 hTryLock :: Handle -> LockMode -> IO Bool hTryLock h mode = lockImpl h "hTryLock" mode False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04d6433158d95658684cf419c4ba5725d2aa539e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04d6433158d95658684cf419c4ba5725d2aa539e You're receiving 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 24 17:16:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 13:16:41 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Implement Quick Look impredicativity Message-ID: <5f6cd479cf057_80b3f84030bb514141998b7@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 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/04d6433158d95658684cf419c4ba5725d2aa539e...9fa26aa16f9eee0b56b5d9e65c16367d7b789996 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04d6433158d95658684cf419c4ba5725d2aa539e...9fa26aa16f9eee0b56b5d9e65c16367d7b789996 You're receiving 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 24 17:17:17 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 13:17:17 -0400 Subject: [Git][ghc/ghc][master] PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Message-ID: <5f6cd49d5b717_80b8da80b01421823c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 4 changed files: - compiler/GHC/HsToCore/PmCheck/Types.hs - + testsuite/tests/pmcheck/should_compile/T18708.hs - + testsuite/tests/pmcheck/should_compile/T18708.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -350,16 +350,17 @@ coreExprAsPmLit e = case collectArgs e of -- Take care of -XRebindableSyntax. The last argument should be the (only) -- integer literal, otherwise we can't really do much about it. | [Lit l] <- dropWhile (not . is_lit) args - -- getOccFS because of -XRebindableSyntax - , getOccFS (idName x) == getOccFS fromIntegerName + , is_rebound_name x fromIntegerName -> literalToPmLit (literalType l) l >>= overloadPmLit (exprType e) (Var x, args) -- Similar to fromInteger case | [r] <- dropWhile (not . is_ratio) args - , getOccFS (idName x) == getOccFS fromRationalName + , is_rebound_name x fromRationalName -> coreExprAsPmLit r >>= overloadPmLit (exprType e) - (Var x, [Type _ty, _dict, s]) - | idName x == fromStringName + (Var x, args) + | is_rebound_name x fromStringName + -- With -XRebindableSyntax or without: The first String argument is what we are after + , s:_ <- filter (eqType stringTy . exprType) args -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings -> coreExprAsPmLit s >>= overloadPmLit (exprType e) -- These last two cases handle String literals @@ -382,6 +383,11 @@ coreExprAsPmLit e = case collectArgs e of | otherwise = False + -- | Compares the given Id to the Name based on OccName, to detect + -- -XRebindableSyntax. + is_rebound_name :: Id -> Name -> Bool + is_rebound_name x n = getOccFS (idName x) == getOccFS n + instance Outputable PmLitValue where ppr (PmLitInt i) = ppr i ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough ===================================== testsuite/tests/pmcheck/should_compile/T18708.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} + +module A (main) where + +import Prelude +import Data.Text + + +fromString :: String -> Text +fromString = pack + +y :: Text +y = "y" + +main :: IO () +main = do + case y of + "y" -> return () + return () ===================================== testsuite/tests/pmcheck/should_compile/T18708.stderr ===================================== @@ -0,0 +1,5 @@ + +T18708.hs:18:3: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: + Patterns not matched: p where p is not one of {"y"} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,8 @@ test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18708', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d0ce0eb772bf69c57e14f30c16c606ab5035816 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d0ce0eb772bf69c57e14f30c16c606ab5035816 You're receiving 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 24 17:17:52 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 13:17:52 -0400 Subject: [Git][ghc/ghc][master] Namespace the Hadrian linting rule for base Message-ID: <5f6cd4c0d55_80b3f849027e814142204b7@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 1 changed file: - hadrian/src/Rules/Lint.hs Changes: ===================================== hadrian/src/Rules/Lint.hs ===================================== @@ -7,21 +7,21 @@ import Settings.Builders.Common import System.Directory (findExecutable) lintRules :: Rules () -lintRules = "lint" ~> lint +lintRules = "lint:base" ~> lint base -lint :: Action () -lint = do +lint :: Action () -> Action () +lint lintAction = do isHlintPresent <- isJust <$> (liftIO $ findExecutable "hlint") if isHlintPresent then do putBuild "| Running the linter…" - lintBase + lintAction putSuccess "| Done." else putFailure "| Please make sure you have the `hlint` executable in your $PATH" -lintBase :: Action () -lintBase = do +base :: Action () +base = do topDir <- topDirectory buildDir <- buildRoot let stage1Lib = topDir buildDir "stage1/lib" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/007940d2fa1ac4f8046989d4af1d088914612a78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/007940d2fa1ac4f8046989d4af1d088914612a78 You're receiving 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 24 17:18:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 13:18:55 -0400 Subject: [Git][ghc/ghc][wip/test-hadrian-stack-build] gitlab-ci: Verify that Hadrian builds with Stack Message-ID: <5f6cd4fff578_80b3f841131c3a41422101@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: Ben Gamari pushed to branch wip/test-hadrian-stack-build at Glasgow Haskell Compiler / GHC Commits: 5f3a7f5f by Ben Gamari at 2020-09-24T13:18:49-04:00 gitlab-ci: Verify that Hadrian builds with Stack [...] 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: Ben Gamari Subject: [Git][ghc/ghc][wip/test-hadrian-stack-build] gitlab-ci: Verify that Hadrian builds with Stack Date: Thu, 24 Sep 2020 13:18:55 -0400 Size: 43102 URL: From gitlab at gitlab.haskell.org Thu Sep 24 17:22:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 13:22:17 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 6 commits: Refactor CLabel pretty-printing Message-ID: <5f6cd5c98332_80b3f8486a2600814222812@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 57f44163 by Ben Gamari at 2020-09-24T13:22:12-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 3488290b by Ben Gamari at 2020-09-24T13:22:12-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/Utils/Outputable.hs - hadrian/src/Base.hs - libraries/Cabal - libraries/base/.hlint.yaml - libraries/base/Control/Concurrent/Chan.hs - libraries/base/Control/Concurrent/QSem.hs - libraries/base/Control/Concurrent/QSemN.hs - libraries/base/Control/Monad/ST/Lazy/Imp.hs - libraries/base/Data/String.hs - libraries/base/Debug/Trace.hs - libraries/base/Foreign/Marshal/Array.hs - libraries/base/Foreign/Marshal/Utils.hs - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/Environment.hs - libraries/base/GHC/Event/Array.hs - libraries/base/GHC/Event/Control.hs - libraries/base/GHC/Event/Manager.hs - libraries/base/GHC/Event/Thread.hs - libraries/base/GHC/Event/TimerManager.hs - libraries/base/GHC/Fingerprint.hs - libraries/base/GHC/IO/Buffer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/102b172828855545732f7b1348fb9660f8a724bd...3488290b7cec013a6e8b8b3c97dc732e0a7a83b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/102b172828855545732f7b1348fb9660f8a724bd...3488290b7cec013a6e8b8b3c97dc732e0a7a83b0 You're receiving 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 24 17:38:40 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 13:38:40 -0400 Subject: [Git][ghc/ghc][wip/backports] Bump Cabal, directory, process submodules Message-ID: <5f6cd9a0cd613_80b3f84941663241424165a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: fa75af74 by Ben Gamari at 2020-09-24T13:38:18-04:00 Bump Cabal, directory, process submodules To accomodate Win32 2.10.0.0. - - - - - 3 changed files: - libraries/Cabal - libraries/directory - libraries/process Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit cb1d1a6ead68f0e1b209277e79ec608980e9ac84 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa75af74342c4c4ff27e365b188c1b122f489e7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa75af74342c4c4ff27e365b188c1b122f489e7f You're receiving 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 24 17:48:40 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 24 Sep 2020 13:48:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f6cdbf857dd9_80bd7edb20142460ea@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 3a31e8f2 by Andreas Klebinger at 2020-09-24T13:48:28-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - 4afceb68 by Ben Gamari at 2020-09-24T13:48:29-04:00 ci.sh: Factor out common utilities - - - - - 212c923b by Ben Gamari at 2020-09-24T13:48:29-04:00 ci: Add ad-hoc performance testing rule - - - - - cac21719 by Zubin Duggal at 2020-09-24T13:48:31-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - a1946713 by Krzysztof Gogolewski at 2020-09-24T13:48:32-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 8e5975e2 by Sebastian Graf at 2020-09-24T13:48:32-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - f7d56807 by Sebastian Graf at 2020-09-24T13:48:32-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - d3a4b24b by Sebastian Graf at 2020-09-24T13:48:32-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 7fce3cd4 by Sven Tennie at 2020-09-24T13:48:33-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.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/HsToCore/PmCheck/Types.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/f9a1bc7252a671dac36a69130ae309b5006703a4...7fce3cd4d2319c40355e2031a6d772280f0fe421 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9a1bc7252a671dac36a69130ae309b5006703a4...7fce3cd4d2319c40355e2031a6d772280f0fe421 You're receiving 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 24 18:38:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 14:38:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18745 Message-ID: <5f6ce7bde9da4_80b3f84511a43c414277636@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T18745 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18745 You're receiving 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 24 19:11:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 15:11:36 -0400 Subject: [Git][ghc/ghc][wip/T18528] Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f6cef68cfc10_80b3f8486382670143063be@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18528 at Glasgow Haskell Compiler / GHC Commits: 6de1204b by Richard Eisenberg at 2020-09-24T15:11:09-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T5321Fun - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -407,8 +407,9 @@ funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- -- @ --- FUN :: forall {m :: Multiplicity} {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. --- TYPE rep1 -> TYPE rep2 -> * +-- FUN :: forall (m :: Multiplicity) -> +-- forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. +-- TYPE rep1 -> TYPE rep2 -> * -- @ -- -- The runtime representations quantification is left inferred. This ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkNthCo, nthCoRole, mkLRCo, + mkNthCo, mkNthCoFunCo, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, @@ -1052,23 +1052,8 @@ mkNthCo r n co -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4)) - go r n co@(FunCo r0 w arg res) - -- See Note [Function coercions] - -- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) - -- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) - -- Then we want to behave as if co was - -- TyConAppCo mult argk_co resk_co arg_co res_co - -- where - -- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) - -- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) - -- i.e. mkRuntimeRepCo - = case n of - 0 -> ASSERT( r == Nominal ) w - 1 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg - 2 -> ASSERT( r == Nominal ) mkRuntimeRepCo res - 3 -> ASSERT( r == r0 ) arg - 4 -> ASSERT( r == r0 ) res - _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr co) + go _ n (FunCo _ w arg res) + = mkNthCoFunCo n w arg res go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n , (vcat [ ppr tc @@ -1120,7 +1105,28 @@ mkNthCo r n co | otherwise = True - +-- | Extract the nth field of a FunCo +mkNthCoFunCo :: Int -- ^ "n" + -> CoercionN -- ^ multiplicity coercion + -> Coercion -- ^ argument coercion + -> Coercion -- ^ result coercion + -> Coercion -- ^ nth coercion from a FunCo +-- See Note [Function coercions] +-- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) +-- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) +-- Then we want to behave as if co was +-- TyConAppCo mult argk_co resk_co arg_co res_co +-- where +-- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) +-- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) +-- i.e. mkRuntimeRepCo +mkNthCoFunCo n w co1 co2 = case n of + 0 -> w + 1 -> mkRuntimeRepCo co1 + 2 -> mkRuntimeRepCo co2 + 3 -> co1 + 4 -> co2 + _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr w $$ ppr co1 $$ ppr co2) -- | If you're about to call @mkNthCo r n co@, then @r@ should be -- whatever @nthCoRole n co@ returns. ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -332,6 +332,7 @@ opt_co4 env _sym rep r (NthCo _r n co) , Just (_tc, args) <- ASSERT( r == _r ) splitTyConApp_maybe ty = liftCoSubst (chooseRole rep r) env (args `getNth` n) + | Just (ty, _) <- isReflCo_maybe co , n == 0 , Just (tv, _) <- splitForAllTy_maybe ty @@ -342,6 +343,11 @@ opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) = ASSERT( r == r1 ) opt_co4_wrap env sym rep r (cos `getNth` n) +-- see the definition of GHC.Builtin.Types.Prim.funTyCon +opt_co4 env sym rep r (NthCo r1 n (FunCo _r2 w co1 co2)) + = ASSERT( r == r1 ) + opt_co4_wrap env sym rep r (mkNthCoFunCo n w co1 co2) + opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) -- works for both tyvar and covar = ASSERT( r == _r ) @@ -349,18 +355,16 @@ opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) opt_co4_wrap env sym rep Nominal eta opt_co4 env sym rep r (NthCo _r n co) - | TyConAppCo _ _ cos <- co' - , let nth_co = cos `getNth` n + | Just nth_co <- case co' of + TyConAppCo _ _ cos -> Just (cos `getNth` n) + FunCo _ w co1 co2 -> Just (mkNthCoFunCo n w co1 co2) + ForAllCo _ eta _ -> Just eta + _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co else nth_co - | ForAllCo _ eta _ <- co' - = if rep - then opt_co4_wrap (zapLiftingContext env) False True Nominal eta - else eta - | otherwise = wrapRole rep r $ NthCo r n co' where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6de1204b42b5fbce15c11ba4e08b30568325408c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6de1204b42b5fbce15c11ba4e08b30568325408c You're receiving 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 24 19:14:46 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 15:14:46 -0400 Subject: [Git][ghc/ghc][wip/test-hadrian-stack-build] gitlab-ci: Verify that Hadrian builds with Stack Message-ID: <5f6cf0261f27d_80ba8d9b181430834a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/test-hadrian-stack-build at Glasgow Haskell Compiler / GHC Commits: aaf18aaf by Ben Gamari at 2020-09-24T15:14:30-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 3 changed files: - .gitlab-ci.yml - hadrian/build-stack - hadrian/build-stack.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -234,6 +234,17 @@ lint-release-changelogs: tags: - x86_64-linux +# Verify that Hadrian builds with stack. Note that we don't actually perform a +# build of GHC itself; we merely test that the Hadrian executable builds and +# works (by invoking `hadrian --version`). +stack-hadrian-build: + extends: .validate-linux-hadrian + stage: build + script: + - .gitlab/ci.sh setup + - .gitlab/ci.sh configure + - hadrian/build-stack --version + validate-x86_64-linux-deb9-hadrian: extends: .validate-linux-hadrian stage: build ===================================== hadrian/build-stack ===================================== @@ -3,11 +3,13 @@ # Make sure that the script exits if Hadrian fails to build set -euo pipefail +STACK="${STACK:-stack}" + # Make sure Hadrian is up-to-date cd hadrian -stack build --no-library-profiling ${HADRIAN_NIX:+--nix} +$STACK build --no-library-profiling ${HADRIAN_NIX:+--nix} # Run Hadrian in the top-level GHC directory -stack exec hadrian -- \ +$STACK exec hadrian -- \ --directory ".." \ "$@" ===================================== hadrian/build-stack.bat ===================================== @@ -3,5 +3,9 @@ setlocal rem Change the current directory to the one containing this script cd %~dp0 +if "%STACK%"=="" ( + set STACK=stack +) + rem Build and run Hadrian in GHC top directory forwarding additional user arguments -stack run hadrian --cwd=.. -- %* +%STACK% run hadrian --cwd=.. -- %* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaf18aaf8fc3fd1e21eaecbd8e32ca4a3c654222 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aaf18aaf8fc3fd1e21eaecbd8e32ca4a3c654222 You're receiving 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 24 19:39:09 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 24 Sep 2020 15:39:09 -0400 Subject: [Git][ghc/ghc][wip/T16762] 18 commits: Remove the list of loaded modules from the ghci prompt Message-ID: <5f6cf5dda3ed4_80b3f84942743d81432482@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 7d233afc by Ryan Scott at 2020-09-24T20:38:33+01:00 WIP: T16762 [ci skip] - - - - - 8ab6f43f by Simon Peyton Jones at 2020-09-24T20:38:33+01:00 Wibbbles - - - - - ac1f0e91 by Simon Peyton Jones at 2020-09-24T20:38:33+01:00 More wibbles - - - - - ef5c318f by Simon Peyton Jones at 2020-09-24T20:38:33+01:00 More wibbles - - - - - 02c8c010 by Simon Peyton Jones at 2020-09-24T20:38:34+01:00 More wibbles --- getting there - - - - - ab10b48e by Ryan Scott at 2020-09-24T20:38:34+01:00 Push through some Haddock changes, disable warnings in GHC.Iface.Ext.Ast for now - - - - - 7a476d4b by Simon Peyton Jones at 2020-09-24T20:38:34+01:00 More wibbles - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/PmCheck/Types.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/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/832a27d190f53a8135bb21cce32dc6bdd7e57fdb...7a476d4b0207b5d9a791c129a9a7fd919715118b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/832a27d190f53a8135bb21cce32dc6bdd7e57fdb...7a476d4b0207b5d9a791c129a9a7fd919715118b You're receiving 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 24 21:15:01 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Thu, 24 Sep 2020 17:15:01 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] 83 commits: .gitignore *.hiedb files Message-ID: <5f6d0c556d853_80b10251128143465b2@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - d061d49e by Alan Zimmerman at 2020-09-24T22:14:24+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 Remove LHsLocalBinds 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 - .gitmodules - README.md - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6ea932fa8e64fdce493ed74886b4e276d723e16...d061d49e15a42f5562eeceb8393fc766aa459a53 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6ea932fa8e64fdce493ed74886b4e276d723e16...d061d49e15a42f5562eeceb8393fc766aa459a53 You're receiving 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 24 21:42:13 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Thu, 24 Sep 2020 17:42:13 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (wip) Message-ID: <5f6d12b5a93ac_80b3f849d86271414357796@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: f03ad0c9 by Daniel Rogozin at 2020-09-25T00:41:34+03:00 Fall back to types when looking up data constructors (wip) - - - - - 3 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,17 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = do { mb_promoted_rdr <- lookupOccRn_maybe promoted_rdr + ; case mb_promoted_rdr of + Nothing -> return Nothing + Just name -> return (Just name) + } + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1065,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig m occ) = fmap (Orig m) (promoteOccName occ) +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f03ad0c9b719fec6ab63a151e0dc7b39a49fabf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f03ad0c9b719fec6ab63a151e0dc7b39a49fabf6 You're receiving 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 24 21:54:21 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Thu, 24 Sep 2020 17:54:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/17919 Message-ID: <5f6d158def6f9_80b3f848aa6388c1436811a@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/17919 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/17919 You're receiving 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 24 22:06:15 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Thu, 24 Sep 2020 18:06:15 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/17919 Message-ID: <5f6d185732f84_80b3f84611c3e1c14371910@gitlab.haskell.org.mail> Krzysztof Gogolewski deleted branch wip/17919 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 Thu Sep 24 22:29:02 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Thu, 24 Sep 2020 18:29:02 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] 192 commits: Put CFG weights into their own module (#17957) Message-ID: <5f6d1daecf1ad_80b3f848a35b670143723f8@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 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 - - - - - 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. - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 207a4c09 by Adam Gundry at 2020-09-24T23:28:26+01:00 Update GHC.Records to use hasField instead of getField - - - - - 0c137807 by Adam Gundry at 2020-09-24T23:28:26+01:00 Add updaters to FieldLabels and solve new HasField constraints (#16232) - - - - - 4ffa2e7a by Adam Gundry at 2020-09-24T23:28:26+01:00 Refactor: move addClsInsts and addFamInsts out of tcInstDecls1 Also modify addTyConsToGblEnv to use the thing_inside pattern - - - - - c9f97a19 by Adam Gundry at 2020-09-24T23:28:26+01:00 Update HasField tests Adapt overloadedrecflds tests and T17355 to new definition of HasField Extend hasfieldrun01 test with partial record field test Update hasfieldfail02 test to check unlifted type case Accept changed T14189 output due to FieldLabel additional field Adjust expected output from dynamic-paper Metric Increase: T12227 T12707 T13056 T15630 T18304 T9233 T9675 - - - - - fd42d100 by Adam Gundry at 2020-09-24T23:28:26+01:00 Update user's guide for changes to HasField - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - README.md - 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.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bca7c7995cc382c82d5286353470398bfb6b2200...fd42d100ea2701fc103e7766262db3f793625cd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bca7c7995cc382c82d5286353470398bfb6b2200...fd42d100ea2701fc103e7766262db3f793625cd5 You're receiving 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 24 22:37:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 24 Sep 2020 18:37:53 -0400 Subject: [Git][ghc/ghc][wip/backports] Disable -Wdeprecations for deepseq Message-ID: <5f6d1fc1bcc1a_80bd93672014376992@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 9a4e02b5 by Ben Gamari at 2020-09-24T18:37:27-04:00 Disable -Wdeprecations for deepseq Use to use of Data.Semigroup.Option for NFData instance. - - - - - 2 changed files: - hadrian/src/Settings/Warnings.hs - mk/warnings.mk Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -31,6 +31,7 @@ ghcWarningsArgs = do , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] , package compiler ? pure [ "-Wcpp-undef" ] , package directory ? pure [ "-Wno-unused-imports" ] + , package deepseq ? pure [ "-Wno-deprecations" ] , package ghc ? pure [ "-Wcpp-undef" , "-Wincomplete-uni-patterns" , "-Wincomplete-record-updates" ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# temporarily turn off deprecations in deepseq due to NFData Option instance. +libraries/deepseq_dist-install_EXTRA_HC_OPTS += -Wno-deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a4e02b5950c6cd10b13a16111969ff349e7aa86 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a4e02b5950c6cd10b13a16111969ff349e7aa86 You're receiving 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 25 05:29:11 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 01:29:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Update containers to v0.6.3.1 Message-ID: <5f6d8027c156b_80b3f8486693774144135a9@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4145daec by Simon Jakobi at 2020-09-25T01:28:51-04:00 Update containers to v0.6.3.1 See https://github.com/haskell/containers/issues/737 in case of doubt about the correct release tag. - - - - - e32f037f by Andreas Klebinger at 2020-09-25T01:28:51-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - 6c24b62b by Ben Gamari at 2020-09-25T01:28:52-04:00 ci.sh: Factor out common utilities - - - - - 8b157c6d by Ben Gamari at 2020-09-25T01:28:52-04:00 ci: Add ad-hoc performance testing rule - - - - - f73ebcfd by Zubin Duggal at 2020-09-25T01:28:53-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 43a946bb by Ben Gamari at 2020-09-25T01:28:54-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - d243e384 by Sebastian Graf at 2020-09-25T01:28:54-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 475527ab by Sebastian Graf at 2020-09-25T01:28:54-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - fcad0194 by Sebastian Graf at 2020-09-25T01:28:54-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 8d2f50af by Sven Tennie at 2020-09-25T01:28:55-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 9595d6ec by Arnaud Spiwack at 2020-09-25T01:29:00-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 13ee6e65 by Krzysztof Gogolewski at 2020-09-25T01:29:02-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 21 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Unfold.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - libraries/containers - rts/Printer.c - testsuite/tests/driver/T10970.stdout - + testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/all.T - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr - testsuite/tests/linear/should_fail/all.T - testsuite/tests/pmcheck/should_compile/T17218.stderr - + testsuite/tests/pmcheck/should_compile/T18371.hs - + testsuite/tests/pmcheck/should_compile/T18371b.hs - + testsuite/tests/pmcheck/should_compile/T18609.hs - + testsuite/tests/pmcheck/should_compile/T18609.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -21,7 +21,6 @@ stages: - quick-build # A very quick smoke-test to weed out broken commits - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - testing # head.hackage correctness and compiler performance testing - deploy # push documentation @@ -923,44 +922,6 @@ release-x86_64-windows-integer-simple: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" -############################################################ -# Cleanup -############################################################ - -# Note [Cleaning up after shell executor] -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# -# As noted in [1], gitlab-runner's shell executor doesn't clean up its working -# directory after builds. Unfortunately, we are forced to use the shell executor -# on Darwin. To avoid running out of disk space we add a stage at the end of -# the build to remove the /.../GitLabRunner/builds directory. Since we only run a -# single build at a time on Darwin this should be safe. -# -# We used to have a similar cleanup job on Windows as well however it ended up -# being quite fragile as we have multiple Windows builders yet there is no -# guarantee that the cleanup job is run on the same machine as the build itself -# was run. Consequently we were forced to instead handle cleanup with a separate -# cleanup cron job on Windows. -# -# [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 - -# See Note [Cleanup after shell executor] -cleanup-darwin: - stage: cleanup - tags: - - x86_64-darwin - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - BUILD_DIR=$CI_PROJECT_DIR - - echo "Cleaning $BUILD_DIR" - - cd $HOME - - rm -Rf $BUILD_DIR/* - - exit 0 ############################################################ # Packaging @@ -1095,6 +1056,41 @@ perf-nofib: paths: - nofib.log +############################################################ +# Ad-hoc performance testing +############################################################ + +perf: + stage: testing + dependencies: + - validate-x86_64-linux-deb9-dwarf + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" + rules: + - if: $CI_MERGE_REQUEST_ID + - if: '$CI_COMMIT_BRANCH == "master"' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + tags: + - x86_64-linux-perf + script: + - root=$(pwd)/ghc + - | + mkdir tmp + tar -xf ghc-x86_64-deb9-linux-dwarf.tar.xz -C tmp + pushd tmp/ghc-*/ + ./configure --prefix=$root + make install + popd + rm -Rf tmp + - export BOOT_HC=$(which ghc) + - export HC=$root/bin/ghc + - .gitlab/ci.sh perf_test + artifacts: + expire_in: 12 week + when: always + paths: + - out + + ############################################################ # Documentation deployment via GitLab Pages ############################################################ ===================================== .gitlab/ci.sh ===================================== @@ -10,54 +10,12 @@ hackage_index_state="2020-09-14T19:30:43Z" MIN_HAPPY_VERSION="1.20" MIN_ALEX_VERSION="3.2" -# Colors -BLACK="0;30" -GRAY="1;30" -RED="0;31" -LT_RED="1;31" -BROWN="0;33" -LT_BROWN="1;33" -GREEN="0;32" -LT_GREEN="1;32" -BLUE="0;34" -LT_BLUE="1;34" -PURPLE="0;35" -LT_PURPLE="1;35" -CYAN="0;36" -LT_CYAN="1;36" -WHITE="1;37" -LT_GRAY="0;37" - -# GitLab Pipelines log section delimiters -# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 -start_section() { - name="$1" - echo -e "section_start:$(date +%s):$name\015\033[0K" -} - -end_section() { - name="$1" - echo -e "section_end:$(date +%s):$name\015\033[0K" -} - -echo_color() { - local color="$1" - local msg="$2" - echo -e "\033[${color}m${msg}\033[0m" -} - -error() { echo_color "${RED}" "$1"; } -warn() { echo_color "${LT_BROWN}" "$1"; } -info() { echo_color "${LT_BLUE}" "$1"; } - -fail() { error "error: $1"; exit 1; } - -function run() { - info "Running $*..." - "$@" || ( error "$* failed"; return 1; ) -} - TOP="$(pwd)" +if [ ! -d "$TOP/.gitlab" ]; then + echo "This script expects to be run from the root of a ghc checkout" +fi + +source $TOP/.gitlab/common.sh function setup_locale() { # Musl doesn't provide locale support at all... @@ -437,6 +395,34 @@ function test_hadrian() { --test-compiler="$TOP"/_build/install/bin/ghc } +function cabal_test() { + if [ -z "$OUT" ]; then + fail "OUT not set" + fi + + start_section "Cabal test: $OUT" + mkdir -p "$OUT" + run "$HC" \ + -hidir tmp -odir tmp -fforce-recomp \ + -ddump-to-file -dumpdir "$OUT/dumps" -ddump-timings \ + +RTS --machine-readable "-t$OUT/rts.log" -RTS \ + -package mtl -ilibraries/Cabal/Cabal libraries/Cabal/Cabal/Setup.hs \ + $@ + rm -Rf tmp + end_section "Cabal test: $OUT" +} + +function run_perf_test() { + if [ -z "$HC" ]; then + fail "HC not set" + fi + + mkdir -p out + OUT=out/Cabal-O0 cabal_test -O0 + OUT=out/Cabal-O1 cabal_test -O1 + OUT=out/Cabal-O2 cabal_test -O2 +} + function clean() { rm -R tmp run "$MAKE" --quiet clean || true @@ -507,6 +493,7 @@ case $1 in push_perf_notes exit $res ;; run_hadrian) run_hadrian $@ ;; + perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/common.sh ===================================== @@ -0,0 +1,50 @@ +# Common bash utilities +# ---------------------- + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -16,6 +16,7 @@ find, unsurprisingly, a Core expression. -} {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -394,7 +395,9 @@ sizeExpr :: UnfoldingOpts -- Note [Computing the size of an expression] -sizeExpr opts bOMB_OUT_SIZE top_args expr +-- Forcing bOMB_OUT_SIZE early prevents repeated +-- unboxing of the Int argument. +sizeExpr opts !bOMB_OUT_SIZE top_args expr = size_up expr where size_up (Cast e _) = size_up e ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Driver.Types import GHC.Unit.Module ( ModuleName, ml_hs_file ) import GHC.Utils.Monad ( concatMapM, liftIO ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique ) +import GHC.Types.Name ( Name, nameSrcSpan, nameUnique ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) @@ -52,7 +52,7 @@ import GHC.Core.InstEnv import GHC.Builtin.Types ( mkListTy, mkSumTy ) import GHC.Tc.Types import GHC.Tc.Types.Evidence -import GHC.Types.Var ( Id, Var, EvId, setVarName, varName, varType, varUnique ) +import GHC.Types.Var ( Id, Var, EvId, varName, setVarName, varType, varUnique ) import GHC.Types.Var.Env import GHC.Builtin.Uniques import GHC.Iface.Make ( mkIfaceExports ) @@ -1276,26 +1276,22 @@ instance ( ToHie (RFContext (Located label)) , toHie expr ] -removeDefSrcSpan :: Name -> Name -removeDefSrcSpan n = setNameLoc n noSrcSpan - instance ToHie (RFContext (Located (FieldOcc GhcRn))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name) + [ toHie $ C (RecField c rhs) (L nspan name) ] instance ToHie (RFContext (Located (FieldOcc GhcTc))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous name _ -> - [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name + [ toHie $ C (RecField c rhs) $ L nspan name ] Ambiguous _name _ -> [ ] @@ -1303,13 +1299,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] Ambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -198,6 +198,8 @@ tcExpr e@(HsUnboundVar _ occ) res_ty ; name <- newSysName occ ; let ev = mkLocalId name Many ty ; emitNewExprHole occ ev ty + ; tcEmitBindingUsage bottomUE -- Holes fit any usage environment + -- (#18491) ; tcWrapResultO (UnboundOccurrenceOf occ) e (HsUnboundVar ev occ) ty res_ty } ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -397,7 +397,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferRhoNC rhs + = do { -- The Many on the next line and the unrestricted on the line after + -- are linked. These must be the same multiplicity. Consider + -- x <- rhs -> u + -- + -- The multiplicity of x in u must be the same as the multiplicity at + -- which the rhs has been consumed. When solving #18738, we want these + -- two multiplicity to still be the same. + (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit aaeda192b34a66b1c5359a85271adf8fed26dd12 +Subproject commit 97fe43c54c5c8a9b93ecf5abd7509e8085b63d41 ===================================== rts/Printer.c ===================================== @@ -476,7 +476,8 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { printPtr((P_)payload[i]); - debugBelch("\n"); + debugBelch(" -- "); + printObj((StgClosure*) payload[i]); } else { debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]); } @@ -498,7 +499,8 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, debugBelch(" stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { printPtr((P_)payload[i]); - debugBelch("\n"); + debugBelch(" -- "); + printObj((StgClosure*) payload[i]); } else { debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]); } @@ -509,7 +511,6 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, void printStackChunk( StgPtr sp, StgPtr spBottom ) { - StgWord bitmap; const StgInfoTable *info; ASSERT(sp <= spBottom); @@ -587,7 +588,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) } else { debugBelch("RET_SMALL (%p)\n", info); } - bitmap = info->layout.bitmap; + StgWord bitmap = info->layout.bitmap; printSmallBitmap(spBottom, sp+1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap)); continue; @@ -605,8 +606,13 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) } case RET_BIG: - barf("todo"); - + debugBelch("RET_BIG (%p)\n", sp); + StgLargeBitmap* bitmap = GET_LARGE_BITMAP(info); + printLargeBitmap(spBottom, + (StgPtr)((StgClosure *) sp)->payload, + bitmap, + bitmap->size); + continue; case RET_FUN: { const StgFunInfoTable *fun_info; @@ -697,7 +703,7 @@ void printLargeAndPinnedObjects() for (uint32_t cap_idx = 0; cap_idx < n_capabilities; ++cap_idx) { Capability *cap = capabilities[cap_idx]; - debugBelch("Capability %d: Current pinned object block: %p\n", + debugBelch("Capability %d: Current pinned object block: %p\n", cap_idx, (void*)cap->pinned_object_block); for (bdescr *bd = cap->pinned_object_blocks; bd; bd = bd->link) { debugBelch("%p\n", (void*)bd); ===================================== testsuite/tests/driver/T10970.stdout ===================================== @@ -1,2 +1,2 @@ -0.6.2.1 +0.6.3.1 OK ===================================== testsuite/tests/linear/should_compile/LinearHole.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +{-# OPTIONS_GHC -fdefer-typed-holes -Wno-typed-holes #-} + +module LinearHole where -- #18491 + +f :: Int #-> Bool #-> Char +f x y = _1 ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -35,3 +35,4 @@ test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, [''] test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('LinearHole', normal, compile, ['']) ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module LinearPatternGuardWildcard where + +-- See #18439 + +unsafeConsume :: a #-> () +unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr ===================================== @@ -0,0 +1,5 @@ + +LinearPatternGuardWildcard.hs:7:15: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -27,3 +27,4 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) +test('LinearPatternGuardWildcard', normal, compile_fail, ['']) ===================================== testsuite/tests/pmcheck/should_compile/T17218.stderr ===================================== @@ -1,6 +1,4 @@ T17218.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In an equation for ‘f’: - Patterns not matched: - C + In an equation for ‘f’: Patterns not matched: P ===================================== testsuite/tests/pmcheck/should_compile/T18371.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module Bug where + +import Data.Kind +import Unsafe.Coerce + +type family Sing :: k -> Type + +class SingI a where + sing :: Sing a + +data SingInstance :: forall k. k -> Type where + SingInstance :: SingI a => SingInstance a + +newtype DI (a :: k) = Don'tInstantiate (SingI a => SingInstance a) + +singInstance :: forall k (a :: k). Sing a -> SingInstance a +singInstance s = with_sing_i SingInstance + where + with_sing_i :: (SingI a => SingInstance a) -> SingInstance a + with_sing_i si = unsafeCoerce (Don'tInstantiate si) s + +{-# COMPLETE Sing #-} +pattern Sing :: forall k (a :: k). () => SingI a => Sing a +pattern Sing <- (singInstance -> SingInstance) + where Sing = sing + +----- + +data SBool :: Bool -> Type where + SFalse :: SBool False + STrue :: SBool True +type instance Sing = SBool + +f :: SBool b -> () +f Sing = () + +g :: Sing (b :: Bool) -> () +g Sing = () ===================================== testsuite/tests/pmcheck/should_compile/T18371b.hs ===================================== @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +module Lib where + +type family T + +pattern P :: T +pattern P <- _ +{-# COMPLETE P #-} + +data U = U +type instance T = U + +f :: U -> () +f P = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns, GADTs, DataKinds, KindSignatures, EmptyCase #-} + +-- | All examples from https://arxiv.org/abs/1702.02281 +module GarrigueLeNormand where + +import Data.Kind + +data N = Z | S N + +data Plus :: N -> N -> N -> Type where + PlusO :: Plus Z a a + PlusS :: !(Plus a b c) -> Plus (S a) b (S c) + +data SMaybe a = SJust !a | SNothing + +trivial :: SMaybe (Plus (S Z) Z Z) -> () +trivial SNothing = () + +trivial2 :: Plus (S Z) Z Z -> () +trivial2 x = case x of {} + +easy :: SMaybe (Plus Z (S Z) Z) -> () +easy SNothing = () + +easy2 :: Plus Z (S Z) Z -> () +easy2 x = case x of {} + +harder :: SMaybe (Plus (S Z) (S Z) (S Z)) -> () +harder SNothing = () + +harder2 :: Plus (S Z) (S Z) (S Z) -> () +harder2 x = case x of {} + +invZero :: Plus a b c -> Plus c d Z -> () +invZero !_ !_ | False = () +invZero PlusO PlusO = () + +data T a where + A :: T Int + B :: T Bool + C :: T Char + D :: T Float + +data U a b c d where + U :: U Int Int Int Int + +f :: T a -> T b -> T c -> T d + -> U a b c d + -> () +f !_ !_ !_ !_ !_ | False = () +f A A A A U = () + +g :: T a -> T b -> T c -> T d + -> T e -> T f -> T g -> T h + -> U a b c d + -> U e f g h + -> () +g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = () +g A A A A A A A A U U = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.stderr ===================================== @@ -0,0 +1,13 @@ + +T18609.hs:36:25: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘invZero’: invZero !_ !_ | False = ... + +T18609.hs:51:20: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !_ !_ !_ !_ !_ | False = ... + +T18609.hs:59:35: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: + g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -96,7 +96,7 @@ test('T17215', expect_broken(17215), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17216', expect_broken(17216), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17218', expect_broken(17218), compile, +test('T17218', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17219', expect_broken(17219), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) @@ -140,12 +140,18 @@ test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371b', 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('T18609', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18708', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fce3cd4d2319c40355e2031a6d772280f0fe421...13ee6e65d5bf80af2105df559b6798a6368f9eb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fce3cd4d2319c40355e2031a6d772280f0fe421...13ee6e65d5bf80af2105df559b6798a6368f9eb3 You're receiving 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 25 08:30:57 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Fri, 25 Sep 2020 04:30:57 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (wip) Message-ID: <5f6daac1cdb36_80b3f84528e1b681443691f@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: 43c9d13d by Daniel Rogozin at 2020-09-25T11:30:30+03:00 Fall back to types when looking up data constructors (wip) - - - - - 3 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,13 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1061,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig m occ) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c9d13d989862c85c038f6c50e19775a25bf9ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c9d13d989862c85c038f6c50e19775a25bf9ff You're receiving 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 25 08:55:29 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Fri, 25 Sep 2020 04:55:29 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (wip) Message-ID: <5f6db081764cf_80b3f8490994b8014439135@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: 3576682f by Daniel Rogozin at 2020-09-25T11:54:57+03:00 Fall back to types when looking up data constructors (wip) - - - - - 8 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,13 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1061,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig m occ) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Type variable ‘a’ = a :: k0 used where a value identifier was expected + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3576682f7ef16d5178d03be917ce20d27182d59c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3576682f7ef16d5178d03be917ce20d27182d59c You're receiving 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 25 10:59:42 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 06:59:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f6dcd9e97435_80b3f8468bbc0ac144901cc@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f9d7c4b7 by Andreas Klebinger at 2020-09-25T06:59:18-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - c65b897b by Ben Gamari at 2020-09-25T06:59:18-04:00 ci.sh: Factor out common utilities - - - - - bebbba18 by Ben Gamari at 2020-09-25T06:59:19-04:00 ci: Add ad-hoc performance testing rule - - - - - 2f3e4c71 by Zubin Duggal at 2020-09-25T06:59:20-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 50fbf1f2 by Ben Gamari at 2020-09-25T06:59:20-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - de3c1185 by Sebastian Graf at 2020-09-25T06:59:21-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 4674ac12 by Sebastian Graf at 2020-09-25T06:59:21-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 7f29809f by Sebastian Graf at 2020-09-25T06:59:21-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 38031f2f by Sven Tennie at 2020-09-25T06:59:21-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - e8d6e1a7 by Arnaud Spiwack at 2020-09-25T06:59:28-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 6173f0d6 by Sylvain Henry at 2020-09-25T06:59:33-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 433d175f by Sylvain Henry at 2020-09-25T06:59:33-04:00 Bignum: implement extended GCD (#18427) - - - - - a1444452 by Krzysztof Gogolewski at 2020-09-25T06:59:35-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Unfold.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - rts/Printer.c - testsuite/tests/lib/integer/all.T - + testsuite/tests/lib/integer/gcdeInteger.hs - + testsuite/tests/lib/integer/gcdeInteger.stdout - testsuite/tests/lib/integer/integerGcdExt.hs - + testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/all.T - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr - testsuite/tests/linear/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/13ee6e65d5bf80af2105df559b6798a6368f9eb3...a14444526ad8cc6553770b00505ed7e8035dd767 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ee6e65d5bf80af2105df559b6798a6368f9eb3...a14444526ad8cc6553770b00505ed7e8035dd767 You're receiving 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 25 11:54:09 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Fri, 25 Sep 2020 07:54:09 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (wip) Message-ID: <5f6dda61ed513_80b3f8468bbc05c145084fc@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: cfd8d9ac by Daniel Rogozin at 2020-09-25T14:53:45+03:00 Fall back to types when looking up data constructors (wip) - - - - - 8 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,13 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1061,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Type variable ‘a’ = a :: k0 used where a value identifier was expected + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfd8d9ac98581042425779a91f9894f4a53216b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfd8d9ac98581042425779a91f9894f4a53216b7 You're receiving 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 25 12:42:22 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 25 Sep 2020 08:42:22 -0400 Subject: [Git][ghc/ghc][wip/refactor-pmc] 11 commits: Refactor CLabel pretty-printing Message-ID: <5f6de5ae1fe44_80b3f849c1eeff014517845@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/refactor-pmc at Glasgow Haskell Compiler / GHC Commits: 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - c2dc67cf by Sebastian Graf at 2020-09-25T14:41:59+02:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - a480f67a by Sebastian Graf at 2020-09-25T14:42:01+02:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 24 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Coverage.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af976c014f0f5e3242e672480f50f1812b97e487...a480f67a85c0b692fa3e69f77f50c1f0c5e81d4b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af976c014f0f5e3242e672480f50f1812b97e487...a480f67a85c0b692fa3e69f77f50c1f0c5e81d4b You're receiving 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 25 13:23:37 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Fri, 25 Sep 2020 09:23:37 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] 2 commits: Update user's guide for changes to HasField Message-ID: <5f6def598b271_80b3f84758a0ec414520678@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: c64bf7b3 by Adam Gundry at 2020-09-25T14:22:46+01:00 Update user's guide for changes to HasField - - - - - d32a697d by Adam Gundry at 2020-09-25T14:22:46+01:00 Update HasField tests Adapt overloadedrecflds tests and T17355 to new definition of HasField Extend hasfieldrun01 test with partial record field test Update hasfieldfail02 test to check unlifted type case Accept changed T14189 output due to FieldLabel additional field Adjust expected output from dynamic-paper Add hasfieldrun03 test for example from user's guide Metric Increase: T12227 T12707 T13056 T15630 T18304 T9233 T9675 - - - - - 16 changed files: - docs/users_guide/exts/hasfield.rst - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.hs - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs - testsuite/tests/overloadedrecflds/should_run/all.T - testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stderr - testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout - testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs - testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/typecheck/should_fail/T17355.hs Changes: ===================================== docs/users_guide/exts/hasfield.rst ===================================== @@ -6,15 +6,23 @@ Record field selector polymorphism The module :base-ref:`GHC.Records.` defines the following: :: class HasField (x :: k) r a | x r -> a where - getField :: r -> a + hasField :: r -> (a -> r, a) A ``HasField x r a`` constraint represents the fact that ``x`` is a field of type ``a`` belonging to a record type ``r``. The -``getField`` method gives the record selector function. +``hasField`` method gives the ability to select and update the field. -This allows definitions that are polymorphic over record types with a specified -field. For example, the following works with any record type that has a field -``name :: String``: :: +This module also defines: :: + + getField :: forall x r a . HasField x r a => r -> a + getField = snd . hasField @x + + setField :: forall x r a . HasField x r a => r -> a -> r + setField = fst . hasField @x + +These make it possible to write functions that are polymorphic over record types +with a specified field. For example, the following works with any record type +that has a field ``name :: String``: :: foo :: HasField "name" r String => r -> String foo r = reverse (getField @"name" r) @@ -31,8 +39,8 @@ Solving HasField constraints If the constraint solver encounters a constraint ``HasField x r a`` where ``r`` is a concrete datatype with a field ``x`` in scope, it -will automatically solve the constraint using the field selector as -the dictionary, unifying ``a`` with the type of the field if +will automatically solve the constraint by generating a suitable +dictionary, unifying ``a`` with the type of the field if necessary. This happens irrespective of which extensions are enabled. For example, if the following datatype is in scope :: @@ -52,12 +60,12 @@ to be solved. This retains the existing representation hiding mechanism, whereby a module may choose not to export a field, preventing client modules from accessing or updating it directly. -Solving ``HasField`` constraints depends on the field selector functions that -are generated for each datatype definition: +Solving ``HasField`` constraints depends on the type of the field: -- If a record field does not have a selector function because its type would allow - an existential variable to escape, the corresponding ``HasField`` constraint - will not be solved. For example, :: +- If a record field has a type containing an existential variable, it cannot + have a selector function, and the corresponding ``HasField`` constraint will + not be solved, because this would allow the existential variable to escape. + For example, :: {-# LANGUAGE ExistentialQuantification #-} data Exists t = forall x . MkExists { unExists :: t x } @@ -67,14 +75,16 @@ are generated for each datatype definition: - If a record field has a polymorphic type (and hence the selector function is higher-rank), the corresponding ``HasField`` constraint will not be solved, - because doing so would violate the functional dependency on ``HasField`` and/or - require impredicativity. For example, :: + because doing so would violate the functional dependency on ``HasField`` + and/or require an impredicative constraint (which is not allowed even with + :extension:`ImpredicativeTypes`). For example, :: {-# LANGUAGE RankNTypes #-} data Higher = MkHigher { unHigher :: forall t . t -> t } gives rise to a selector ``unHigher :: Higher -> (forall t . t -> t)`` but does - not lead to solution of the constraint ``HasField "unHigher" Higher a``. + not lead to solution of the constraint ``HasField "unHigher" Higher a`` (which + would require an impredicative instantiation of ``a`` with ``forall t . t -> t``). - A record GADT may have a restricted type for a selector function, which may lead to additional unification when solving ``HasField`` constraints. For example, :: @@ -116,7 +126,7 @@ For example, this instance would make the ``name`` field of ``Person`` accessible using ``#fullname`` as well: :: instance HasField "fullname" Person String where - getField = name + hasField r = (\n -> r { name = n }, name r) More substantially, an anonymous records library could provide ``HasField`` instances for its anonymous records, and thus be @@ -125,19 +135,34 @@ proposal. For example, something like this makes it possible to use ``getField`` to access ``Record`` values with the appropriate string in the type-level list of fields: :: + {-# LANGUAGE DataKinds #-} + {-# LANGUAGE FlexibleContexts #-} + {-# LANGUAGE GADTs #-} + {-# LANGUAGE PolyKinds #-} + {-# LANGUAGE ScopedTypeVariables #-} + {-# LANGUAGE TypeApplications #-} + {-# LANGUAGE TypeOperators #-} + {-# LANGUAGE UndecidableInstances #-} + + import Data.Kind (Type) + import Data.Proxy (Proxy(..)) + import GHC.Records + data Record (xs :: [(k, Type)]) where Nil :: Record '[] Cons :: Proxy x -> a -> Record xs -> Record ('(x, a) ': xs) - instance HasField x (Record ('(x, a) ': xs)) a where - getField (Cons _ v _) = v + instance {-# OVERLAPS #-} HasField x (Record ('(x, a) ': xs)) a where + hasField (Cons p v r) = (\v' -> Cons p v' r, v) instance HasField x (Record xs) a => HasField x (Record ('(y, b) ': xs)) a where - getField (Cons _ _ r) = getField @x r + hasField (Cons p v r) = (\v' -> Cons p v (set v'), a) + where + (set,a) = hasField @x r r :: Record '[ '("name", String) ] - r = Cons Proxy "R" Nil) + r = Cons Proxy "R" Nil - x = getField @"name" r + x = getField @"name" (setField @"name" r "S") Since representations such as this can support field labels with kinds other than ``Symbol``, the ``HasField`` class is poly-kinded (even though the built-in @@ -173,5 +198,27 @@ interests of simplicity we do not permit users to define their own instances either. If a field is not in scope, the corresponding instance is still prohibited, to avoid conflicts in downstream modules. +.. _compatibility-notes: + +Compatibility notes +~~~~~~~~~~~~~~~~~~~ + +``HasField`` was introduced in GHC 8.2. + +In versions of GHC prior to 9.2, the ``HasField`` class provided only a +``getField`` method, so it was not possibly to update fields in a polymorphic +way. This means: + +- Code using ``hasField`` or ``setField`` will require at least GHC 9.2. + +- Code using ``getField`` only may support GHC 8.2 and later, and should use + ``import GHC.Records (HasField, getField)`` which works regardless of whether + ``getField`` is a class method (prior to 9.2) or a function (9.2 and later). +- User-defined ``HasField`` instances must use :extension:`CPP` to support GHC + versions before and after 9.2. +:ref:`record-patsyn` do not lead to automatic solution of ``HasField`` instances +for their fields, so if you replace a datatype with a pattern synonym where +``HasField`` is in use, you may need to define :ref:`virtual-record-fields` +manually. ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 136961 + Total ticks: 139362 ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs ===================================== @@ -2,7 +2,7 @@ import HasFieldFail01_A (T(MkT)) -import GHC.Records (HasField(..)) +import GHC.Records (HasField, getField) -- This should fail to solve the HasField constraint, because foo is -- not in scope. ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.hs ===================================== @@ -1,10 +1,12 @@ {-# LANGUAGE DataKinds, ExistentialQuantification, MagicHash, RankNTypes, TypeApplications #-} -import GHC.Records (HasField(..)) +import GHC.Prim (Int#) +import GHC.Records (HasField, getField) data T = MkT { foo :: forall a . a -> a } data U = forall b . MkU { bar :: b } +data V = MkV { baz :: Int# } -- This should fail because foo is higher-rank. x = getField @"foo" (MkT id) @@ -13,4 +15,7 @@ x = getField @"foo" (MkT id) -- involves an existential). y = getField @"bar" (MkU True) +-- This should fail because baz is not of kind Type. +z = getField @"baz" (MkV 3#) + main = return () ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr ===================================== @@ -1,13 +1,18 @@ -hasfieldfail02.hs:10:5: error: - • No instance for (HasField "foo" T a1) +hasfieldfail02.hs:12:5: error: + • No instance for (HasField "foo" T a2) arising from a use of ‘getField’ • In the expression: getField @"foo" (MkT id) - In an equation for ‘x’: - x = getField @"foo" (MkT id) + In an equation for ‘x’: x = getField @"foo" (MkT id) -hasfieldfail02.hs:14:5: error: - • No instance for (HasField "bar" U a0) +hasfieldfail02.hs:16:5: error: + • No instance for (HasField "bar" U a1) arising from a use of ‘getField’ • In the expression: getField @"bar" (MkU True) In an equation for ‘y’: y = getField @"bar" (MkU True) + +hasfieldfail02.hs:19:5: error: + • No instance for (HasField "baz" V a0) + arising from a use of ‘getField’ + • In the expression: getField @"baz" (MkV 3#) + In an equation for ‘z’: z = getField @"baz" (MkV 3#) ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs ===================================== @@ -7,23 +7,23 @@ data T = MkT { foo :: Int, bar :: Int } -- This is far too polymorphic instance HasField "woo" a Bool where - getField = const True + hasField = undefined -- This conflicts with the built-in instance instance HasField "foo" T Int where - getField = foo + hasField = undefined -- So does this instance HasField "bar" T Bool where - getField = const True + hasField = undefined -- This doesn't conflict because there is no "baz" field in T instance HasField "baz" T Bool where - getField = const True + hasField = undefined -- Bool has no fields, so this is okay instance HasField a Bool Bool where - getField = id + hasField = undefined data family V a b c d @@ -32,8 +32,8 @@ data instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) } -- Data families cannot have HasField instances, because they may get -- fields defined later on instance HasField "baz" (V a b c d) Bool where - getField = const True + hasField = undefined -- Function types can have HasField instances, in case it's useful instance HasField "woo" (a -> b) Bool where - getField = const True + hasField = undefined ===================================== testsuite/tests/overloadedrecflds/should_run/all.T ===================================== @@ -14,6 +14,7 @@ test('overloadedlabelsrun03', normal, compile_and_run, ['']) test('overloadedlabelsrun04', [extra_files(['OverloadedLabelsRun04_A.hs']), omit_ways(prof_ways)], multimod_compile_and_run, ['overloadedlabelsrun04', config.ghc_th_way_flags]) -test('hasfieldrun01', normal, compile_and_run, ['']) +test('hasfieldrun01', [exit_code(1)], compile_and_run, ['']) test('hasfieldrun02', normal, compile_and_run, ['']) +test('hasfieldrun03', normal, compile_and_run, ['']) test('T12243', normal, compile_and_run, ['']) ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs ===================================== @@ -6,14 +6,19 @@ , TypeFamilies , TypeApplications #-} +{-# OPTIONS_GHC -dcore-lint #-} -import GHC.Records (HasField(..)) +import GHC.Records (HasField(..), getField, setField) + +data S a where + MkS :: { soo :: Either p q } -> S (p,q) type family B where B = Bool data T = MkT { foo :: Int, bar :: B } data U a b = MkU { baf :: a } + deriving Show data family V a b c d data instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) } @@ -22,8 +27,16 @@ data W a where MkW :: { woo :: a } -> W [a] data Eq a => X a = MkX { xoo :: a } + deriving Show data Y a = Eq a => MkY { yoo :: a } +data Z = MkZ1 { partial :: Int, total :: Bool } + | MkZ2 { total :: Bool } + deriving Show + +s :: S ((), Bool) +s = MkS (Right True) + t = MkT 42 True u :: U Char Char @@ -37,15 +50,28 @@ x = MkX True y = MkY True +z = MkZ2 False + -- A virtual foo field for U instance HasField "foo" (U a b) [Char] where - getField _ = "virtual" + hasField r = (const r, "virtual") -main = do print (getField @"foo" t) +main = do print (getField @"soo" s) + print (getField @"foo" t) + print (getField @"foo" (setField @"foo" t 11)) print (getField @"bar" t) + print (getField @"bar" (setField @"bar" t False)) print (getField @"baf" u) + print (setField @"baf" u 'y') print (getField @"foo" u) + print (setField @"foo" u "ignored") print (getField @"baz" v) + print (getField @"baz" (setField @"baz" v (40 :: Int, 'y', False, True))) print (getField @"woo" w) + print (getField @"woo" (setField @"woo" w False)) print (getField @"xoo" x) + print (setField @"xoo" x False) print (getField @"yoo" y) + print (getField @"yoo" (setField @"yoo" y False)) + print (getField @"total" (setField @"total" z True)) + print (setField @"partial" z 42) -- Should throw a "No match" error ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stderr ===================================== @@ -0,0 +1 @@ +hasfieldrun01: No match in record selector partial ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout ===================================== @@ -1,8 +1,18 @@ +Right True 42 +11 True +False 'x' +MkU {baf = 'y'} "virtual" +MkU {baf = 'x'} (42,'x',True,False) +(40,'y',False,True) True +False True +MkX {xoo = False} +True +False True ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs ===================================== @@ -0,0 +1,33 @@ + -- This tests an example included in the GHC user's guide (see hasfield.rst). + -- Please update the user's guide if it needs to be changed! + + {-# LANGUAGE DataKinds #-} + {-# LANGUAGE FlexibleContexts #-} + {-# LANGUAGE GADTs #-} + {-# LANGUAGE PolyKinds #-} + {-# LANGUAGE ScopedTypeVariables #-} + {-# LANGUAGE TypeApplications #-} + {-# LANGUAGE TypeOperators #-} + {-# LANGUAGE UndecidableInstances #-} + + import Data.Kind (Type) + import Data.Proxy (Proxy(..)) + import GHC.Records + + data Record (xs :: [(k, Type)]) where + Nil :: Record '[] + Cons :: Proxy x -> a -> Record xs -> Record ('(x, a) ': xs) + + instance {-# OVERLAPS #-} HasField x (Record ('(x, a) ': xs)) a where + hasField (Cons p v r) = (\v' -> Cons p v' r, v) + instance HasField x (Record xs) a => HasField x (Record ('(y, b) ': xs)) a where + hasField (Cons p v r) = (\v' -> Cons p v (set v'), a) + where + (set,a) = hasField @x r + + r :: Record '[ '("name", String) ] + r = Cons Proxy "R" Nil + + x = getField @"name" (setField @"name" r "S") + + main = print x ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout ===================================== @@ -0,0 +1 @@ +"S" ===================================== testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs ===================================== @@ -6,6 +6,7 @@ , MultiParamTypeClasses , OverloadedLabels , ScopedTypeVariables + , StandaloneDeriving , TypeApplications , TypeOperators , UndecidableInstances @@ -15,20 +16,29 @@ import GHC.OverloadedLabels import GHC.Records import GHC.TypeLits import Data.Kind +import Data.Proxy data Label (x :: Symbol) = Label + +instance KnownSymbol x => Show (Label x) where + show _ = "#" ++ symbolVal (Proxy @x) + data Labelled x a = Label x := a + deriving Show data Rec :: forall k. [(k, Type)] -> Type where Nil :: Rec '[] (:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs) +instance Show (Rec '[]) where + show Nil = "Nil" +deriving instance (KnownSymbol x, Show a, Show (Rec xs)) => Show (Rec ('(x, a) ': xs)) infixr 5 :> instance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where - getField ((_ := v) :> _) = v + hasField ((l := v) :> xs) = (\ v' -> (l := v') :> xs, v) instance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where - getField (_ :> vs) = getField @foo vs + hasField (x :> vs) = (\ v -> x :> setField @foo vs v, getField @foo vs) instance y ~ x => IsLabel y (Label x) where fromLabel = Label @@ -44,3 +54,4 @@ y = #bar := 'x' :> undefined main = do print (#foo x) print (#bar x) print (#bar y) + print (setField @"foo" x 11) ===================================== testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout ===================================== @@ -1,3 +1,4 @@ 42 True 'x' +#foo := 11 :> (#bar := True :> Nil) ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -134,6 +134,7 @@ (FieldLabel {FastString: "f"} (False) + (()) {Name: T14189.f}))])) [(AvailTC {Name: T14189.MyType} @@ -142,6 +143,7 @@ [(FieldLabel {FastString: "f"} (False) + (()) {Name: T14189.f})])])]) (Nothing))) ===================================== testsuite/tests/typecheck/should_fail/T17355.hs ===================================== @@ -8,4 +8,4 @@ data Foo = Foo { poly :: forall a. a -> a } instance Generic (forall a . a) instance HasField "myPoly" Foo (forall a. a -> a) where - getField (Foo x) = x + hasField (Foo x) = (undefined, x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd42d100ea2701fc103e7766262db3f793625cd5...d32a697da0445cdda59ac72fa23fb54b8952475f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd42d100ea2701fc103e7766262db3f793625cd5...d32a697da0445cdda59ac72fa23fb54b8952475f You're receiving 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 25 13:35:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 09:35:55 -0400 Subject: [Git][ghc/ghc][wip/backports] 2 commits: Bump Cabal, haskeline, directory, process submodules Message-ID: <5f6df23b287a6_80b3f84424638a814521425@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: c8c6c4a2 by Ben Gamari at 2020-09-25T09:35:43-04:00 Bump Cabal, haskeline, directory, process submodules To accomodate Win32 2.10.0.0. - - - - - 4d71fb5b by Ben Gamari at 2020-09-25T09:35:50-04:00 Disable -Wdeprecations for deepseq Use to use of Data.Semigroup.Option for NFData instance. - - - - - 6 changed files: - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/directory - libraries/haskeline - libraries/process - mk/warnings.mk Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -31,6 +31,7 @@ ghcWarningsArgs = do , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] , package compiler ? pure [ "-Wcpp-undef" ] , package directory ? pure [ "-Wno-unused-imports" ] + , package deepseq ? pure [ "-Wno-deprecations" ] , package ghc ? pure [ "-Wcpp-undef" , "-Wincomplete-uni-patterns" , "-Wincomplete-record-updates" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 5f16b76168f13c6413413386efc44fb1152048d5 +Subproject commit 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit cb1d1a6ead68f0e1b209277e79ec608980e9ac84 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# temporarily turn off deprecations in deepseq due to NFData Option instance. +libraries/deepseq_dist-install_EXTRA_HC_OPTS += -Wno-deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a4e02b5950c6cd10b13a16111969ff349e7aa86...4d71fb5b1c5a6ff13d5d23b8c10830313a6e21f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a4e02b5950c6cd10b13a16111969ff349e7aa86...4d71fb5b1c5a6ff13d5d23b8c10830313a6e21f7 You're receiving 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 25 14:01:08 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Fri, 25 Sep 2020 10:01:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/winio_atomics Message-ID: <5f6df82415ce7_80b3f84460a9b501452215a@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/winio_atomics You're receiving 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 25 14:25:41 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Fri, 25 Sep 2020 10:25:41 -0400 Subject: [Git][ghc/ghc][wip/bump-base-4.16] 47 commits: rts/nonmoving: Add missing STM write barrier Message-ID: <5f6dfde572603_80b3f8486c50db014527875@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - eece4f72 by Vladislav Zavialov at 2020-09-25T17:23:21+03:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 20 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/601b2601ee73aa1d2e801f4aa370d3be51f02813...eece4f72afdf1fca80fcec3ecbd8e684df849e1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/601b2601ee73aa1d2e801f4aa370d3be51f02813...eece4f72afdf1fca80fcec3ecbd8e684df849e1c You're receiving 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 25 16:04:23 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 25 Sep 2020 12:04:23 -0400 Subject: [Git][ghc/ghc][wip/refactor-pmc] Extract SharedIdEnv into its own module Message-ID: <5f6e15077cff0_80b3f848c280ca8145570d7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/refactor-pmc at Glasgow Haskell Compiler / GHC Commits: d9a5a13b by Sebastian Graf at 2020-09-25T18:04:14+02:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 5 changed files: - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -98,20 +98,20 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Nabla -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) +prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon]) prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList where - attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts nabla u)) + attach_refuts (u, (x, sdoc)) = (u, (sdoc, lookupRefuts nabla x)) -type PmPprM a = RWS Nabla () (DIdEnv SDoc, [SDoc]) a +type PmPprM a = RWS Nabla () (DIdEnv (Id, 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 :: Nabla -> PmPprM a -> (a, DIdEnv SDoc) +runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc)) runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of (a, (renamings, _), _) -> (a, renamings) @@ -122,9 +122,9 @@ getCleanName x = do (renamings, name_supply) <- get let (clean_name:name_supply') = name_supply case lookupDVarEnv renamings x of - Just nm -> pure nm + Just (_, nm) -> pure nm Nothing -> do - put (extendDVarEnv renamings x clean_name, name_supply') + put (extendDVarEnv renamings x (x, clean_name), name_supply') pure clean_name checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached @@ -139,8 +139,8 @@ checkRefuts x = do -- underscores. Even with a type signature, if it's not too noisy. pprPmVar :: PprPrec -> Id -> PmPprM SDoc -- Type signature is "too noisy" by my definition if it needs to parenthesize. --- I like "not matched: _ :: Proxy (DIdEnv SDoc)", --- but I don't like "not matched: (_ :: stuff) (_:_) (_ :: Proxy (DIdEnv SDoc))" +-- I like "not matched: _ :: Proxy (DIdEnv (Id, SDoc))", +-- but I don't like "not matched: (_ :: stuff) (_:_) (_ :: Proxy (DIdEnv (Id, 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 ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -45,10 +45,9 @@ import GHC.Utils.Error ( pprErrMsgBagWithLoc ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Bag -import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.DFM +import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) @@ -494,7 +493,7 @@ emptyVarInfo x lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env x) +lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM 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 @@ -521,7 +520,7 @@ trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = set_vi <$> f (lookupVarInfo ts x) where set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env (vi_id vi') vi' } }) + (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) {- Note [Coverage checking Newtype matches] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -554,14 +553,11 @@ where you can find the solution in a perhaps more digestible format. ------------------------------------------------ -- * Exported utility functions querying 'Nabla' -lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] +lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt{ts_facts = (SDIE env)}) } k = - case lookupUDFM_Directly env (getUnique k) of - Nothing -> [] - Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) - Just (Entry vi) -> pmAltConSetElems (vi_neg vi) +lookupRefuts MkNabla{ nabla_tm_st = ts } x = + pmAltConSetElems $ vi_neg $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -718,7 +714,7 @@ addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do 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 = ts{ts_facts = setEntrySDIE env y vi' } } + pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". @@ -732,7 +728,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env y vi' } } + $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -805,7 +801,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -825,55 +821,27 @@ equateTys ts us = , not (eqType t u) ] --- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the +-- | Adds a @x ~ y@ constraint by merging the two 'VarInfo's and record the -- gained knowledge in 'Nabla'. -- --- 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. +-- Returns @Nothing@ when there's a contradiction while merging. 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 :: Nabla -> Id -> Id -> MaybeT DsM Nabla -addVarCt nabla at MkNabla{ nabla_tm_st = TmSt{ ts_facts = 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 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. --- Makes sure that the positive and negative facts of @x@ and @y@ are --- compatible. --- Preconditions: @not (sameRepresentativeSDIE env x y)@ --- --- See Note [TmState invariants]. -equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla -equate nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x y - = ASSERT( not (sameRepresentativeSDIE env x y) ) - case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env x y } }) - (_, Nothing) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env y x } }) - -- 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... - -- We should decide how to break the tie - MASSERT2( idType (vi_id vi_x) `eqType` idType (vi_id vi_y), text "Not same type" ) - -- First assume that x and y are in the same equivalence class - let env_ind = setIndirectSDIE env x y - -- Then sum up the refinement counters - let env_refs = setEntrySDIE env_ind y vi_y - let nabla_refs = nabla{ nabla_tm_st = ts{ts_facts = env_refs} } - -- and then gradually merge every positive fact we have on x into y - let add_fact nabla (PACA 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 nabla nalt = addNotConCt nabla y nalt - nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_rcm will be updated in addNotConCt, so we are good to - -- go! - pure nabla_neg +addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = + case equateUSDFM env x y of + (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- Add the constraints we had for x to y + (Just vi_x, env') -> do + let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } + -- and then gradually merge every positive fact we have on x into y + let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args + nabla_pos <- foldlM add_pos nabla_equated (vi_pos vi_x) + -- Do the same for negative info + let add_neg nabla nalt = addNotConCt nabla y nalt + foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -1221,11 +1189,11 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = go [] env = pure ts{ts_facts=env} go (x:xs) !env = do vi' <- f (lookupVarInfo ts x) - go xs (setEntrySDIE env x vi') + go xs (addToUSDFM env x vi') traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseSDIE f env + env' <- traverseUSDFM f env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -14,10 +14,6 @@ module GHC.HsToCore.Pmc.Solver.Types ( BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), Nablas(..), initNablas, - -- ** A 'DIdEnv' where entries may be shared - Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, - -- ** Caching residual COMPLETE sets ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -46,10 +42,9 @@ import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.DFM +import GHC.Types.Unique.SDFM import GHC.Types.Name import GHC.Core.DataCon import GHC.Core.ConLike @@ -135,7 +130,7 @@ initTyState = TySt 0 emptyInert -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(SharedDIdEnv VarInfo) + { ts_facts :: !(UniqSDFM Id VarInfo) -- ^ Facts about term variables. Deterministic env, so that we generate -- deterministic error messages. , ts_reps :: !(CoreMap Id) @@ -245,75 +240,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet - --- ** A 'DIdEnv' where entries may be shared - --- | Either @Indirect x@, meaning the value is represented by that of @x@, or --- an @Entry@ containing containing the actual value it represents. -data Shared a - = Indirect !Id - | Entry !a - --- | A 'DIdEnv' in which entries can be shared by multiple 'Id's. --- Merge equivalence classes of two Ids by 'setIndirectSDIE' and set the entry --- of an Id with 'setEntrySDIE'. -newtype SharedDIdEnv a - = SDIE { unSDIE :: DIdEnv (Shared a) } - -emptySDIE :: SharedDIdEnv a -emptySDIE = SDIE emptyDVarEnv - -lookupReprAndEntrySDIE :: SharedDIdEnv a -> Id -> (Id, Maybe a) -lookupReprAndEntrySDIE sdie@(SDIE env) x = case lookupDVarEnv env x of - Nothing -> (x, Nothing) - Just (Indirect y) -> lookupReprAndEntrySDIE sdie y - Just (Entry a) -> (x, Just a) - --- | @lookupSDIE env x@ looks up an entry for @x@, looking through all --- 'Indirect's until it finds a shared 'Entry'. -lookupSDIE :: SharedDIdEnv a -> Id -> Maybe a -lookupSDIE sdie x = snd (lookupReprAndEntrySDIE sdie x) - --- | Check if two variables are part of the same equivalence class. -sameRepresentativeSDIE :: SharedDIdEnv a -> Id -> Id -> Bool -sameRepresentativeSDIE sdie x y = - fst (lookupReprAndEntrySDIE sdie x) == fst (lookupReprAndEntrySDIE sdie y) - --- | @setIndirectSDIE env x y@ sets @x@'s 'Entry' to @Indirect y@, thereby --- merging @x@'s equivalence class into @y@'s. This will discard all info on --- @x@! -setIndirectSDIE :: SharedDIdEnv a -> Id -> Id -> SharedDIdEnv a -setIndirectSDIE sdie@(SDIE env) x y = - SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Indirect y) - --- | @setEntrySDIE env x a@ sets the 'Entry' @x@ is associated with to @a@, --- thereby modifying its whole equivalence class. -setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a -setEntrySDIE sdie@(SDIE env) x a = - SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) - -entriesSDIE :: SharedDIdEnv a -> [a] -entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) - where - preview_entry (Entry e) = Just e - preview_entry _ = Nothing - -traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) -traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE - where - g :: (Unique, Shared a) -> f (Unique, Shared b) - g (u, Indirect y) = pure (u,Indirect y) - g (u, Entry a) = do - a' <- f a - pure (u,Entry a') - -instance Outputable a => Outputable (Shared a) where - ppr (Indirect x) = ppr x - ppr (Entry a) = ppr a - -instance Outputable a => Outputable (SharedDIdEnv a) where - ppr (SDIE env) = ppr env +initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -0,0 +1,121 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ApplicativeDo #-} +{-# OPTIONS_GHC -Wall #-} + +-- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the +-- same entry. See 'UniqSDFM'. +module GHC.Types.Unique.SDFM ( + -- * Unique-keyed, /shared/, deterministic mappings + UniqSDFM, + + emptyUSDFM, + lookupUSDFM, + equateUSDFM, addToUSDFM, + traverseUSDFM + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.DFM +import GHC.Utils.Outputable + +-- | Either @Indirect x@, meaning the value is represented by that of @x@, or +-- an @Entry@ containing containing the actual value it represents. +data Shared key ele + = Indirect !key + | Entry !ele + +-- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a +-- common value of type @ele at . +-- Every such set (\"equivalence class\") has a distinct representative +-- 'Unique'. Supports merging the entries of multiple such sets in a union-find +-- like fashion. +-- +-- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from +-- sets of @key at s to possibly absent entries @ele@, where the sets don't overlap. +-- Example: +-- @ +-- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)] +-- @ +-- On this model we support the following main operations: +-- +-- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@, +-- @'lookupUSDFM' m u5 == Nothing at . +-- * @'equateUSDFM' m u1 u3@ is a no-op, but +-- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to +-- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1 at . +-- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4 at . +-- +-- As well as a few means for traversal/conversion to list. +newtype UniqSDFM key ele + = USDFM { unUSDFM :: UniqDFM key (Shared key ele) } + +emptyUSDFM :: UniqSDFM key ele +emptyUSDFM = USDFM emptyUDFM + +lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele) +lookupReprAndEntryUSDFM (USDFM env) = go + where + go x = case lookupUDFM env x of + Nothing -> (x, Nothing) + Just (Indirect y) -> go y + Just (Entry ele) -> (x, Just ele) + +-- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all +-- 'Indirect's until it finds a shared 'Entry'. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1 +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing +lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele +lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) + +-- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry, +-- thereby merging @x@'s class with @y@'s. +-- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be +-- chosen as the new entry and @x@'s old entry will be returned. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +equateUSDFM + :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) +equateUSDFM usdfm@(USDFM env) x y = + case (lu x, lu y) of + ((x', _) , (y', _)) + | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do + ((x', _) , (_ , Nothing)) -> (Nothing, set_indirect y x') + ((_ , mb_ex), (y', _)) -> (mb_ex, set_indirect x y') + where + lu = lookupReprAndEntryUSDFM usdfm + set_indirect a b = USDFM $ addToUDFM env a (Indirect b) + +-- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@, +-- thereby modifying its whole equivalence class. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)] +-- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)] +addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele +addToUSDFM usdfm@(USDFM env) x v = + USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v) + +traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b) +traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM + where + g :: (Unique, Shared key a) -> f (Unique, Shared key b) + g (u, Indirect y) = pure (u,Indirect y) + g (u, Entry a) = do + a' <- f a + pure (u,Entry a') + +instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where + ppr (Indirect x) = ppr x + ppr (Entry a) = ppr a + +instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where + ppr (USDFM env) = ppr env ===================================== compiler/ghc.cabal.in ===================================== @@ -569,6 +569,7 @@ Library GHC.Data.Stream GHC.Data.StringBuffer GHC.Types.Unique.DFM + GHC.Types.Unique.SDFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9a5a13bd40f89ae43ab04fce07e39b74aaef1dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9a5a13bd40f89ae43ab04fce07e39b74aaef1dd You're receiving 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 25 16:36:50 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 25 Sep 2020 12:36:50 -0400 Subject: [Git][ghc/ghc][wip/infer-mult-more] 19 commits: Remove unused ThBrackCtxt and ResSigCtxt Message-ID: <5f6e1ca2a73f3_80b3f84101b58a414566421@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/infer-mult-more at Glasgow Haskell Compiler / GHC Commits: 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 846057d1 by Krzysztof Gogolewski at 2020-09-25T18:34:27+02:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 16 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83047a104850ff77e076bc66e6127015dfdd5f00...846057d1d750eafa5b84a1cdbb7d5234a7627345 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83047a104850ff77e076bc66e6127015dfdd5f00...846057d1d750eafa5b84a1cdbb7d5234a7627345 You're receiving 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 25 18:12:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 14:12:10 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Cabal, directory, process submodules Message-ID: <5f6e32fa46452_80b3f83700d5164145923f2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 6648ca36 by Ben Gamari at 2020-09-25T14:12:03-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 6 changed files: - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - utils/ghc-cabal/ghc.mk - utils/hsc2hs Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit e4be83379c1299bd254654a8666744b3668fd96f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== utils/ghc-cabal/ghc.mk ===================================== @@ -38,20 +38,20 @@ $(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/. "$(CP)" $< $@ # Minor hack, since we can't reuse the `hs-suffix-rules-srcdir` macro -ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Fields/Lexer.x),) +ifneq ($(wildcard libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.x),) # Lexer.x exists so we have to call Alex ourselves CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Fields/Lexer.hs -bootstrapping/Cabal/Distribution/Fields/Lexer.hs: libraries/Cabal/Cabal/Distribution/Fields/Lexer.x +bootstrapping/Cabal/Distribution/Fields/Lexer.hs: libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.x mkdir -p bootstrapping/Cabal/Distribution/Fields $(call cmd,ALEX) $< -o $@ else -CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Fields/Lexer.hs +CABAL_LEXER_DEP := libraries/Cabal/Cabal/src/Distribution/Fields/Lexer.hs endif -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs) -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs) -$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*/*/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*/*.hs) +$(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/src/Distribution/*.hs) # N.B. Compile with -O0 since this is not a performance-critical executable # and the Cabal takes nearly twice as long to build with -O1. See #16817. @@ -70,7 +70,7 @@ $(ghc-cabal_DIST_BINARY): $(CABAL_LEXER_DEP) utils/ghc-cabal/Main.hs $(TOUCH_DEP -odir bootstrapping \ -hidir bootstrapping \ $(CABAL_LEXER_DEP) \ - -ilibraries/Cabal/Cabal \ + -ilibraries/Cabal/Cabal/src \ -ilibraries/binary/src \ -ilibraries/filepath \ -ilibraries/hpc \ ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 4171a459e9d66ebf71d92368be3d7f55cca3e7e1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6648ca36afd6a3667b00caf1a5f69c9984023715 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6648ca36afd6a3667b00caf1a5f69c9984023715 You're receiving 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 25 18:17:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 14:17:36 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Cabal, directory, process submodules Message-ID: <5f6e3440e499c_80b3f848705d8f414592845@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 3e7a6ef6 by Ben Gamari at 2020-09-25T14:17:11-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 5 changed files: - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - utils/hsc2hs Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 4171a459e9d66ebf71d92368be3d7f55cca3e7e1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e7a6ef6be635107c65c6546d82a5bacfda1a340 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e7a6ef6be635107c65c6546d82a5bacfda1a340 You're receiving 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 25 18:40:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 14:40:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f6e3994e821c_80b3f84860ce7581459876a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 190269ea by Andreas Klebinger at 2020-09-25T14:39:53-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - a4c6ee06 by Ben Gamari at 2020-09-25T14:39:54-04:00 ci.sh: Factor out common utilities - - - - - 72d00edc by Ben Gamari at 2020-09-25T14:39:54-04:00 ci: Add ad-hoc performance testing rule - - - - - 4c166739 by Zubin Duggal at 2020-09-25T14:39:55-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - b56d384b by Ben Gamari at 2020-09-25T14:39:56-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - f6ae9617 by Sebastian Graf at 2020-09-25T14:39:56-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 0d521e75 by Sebastian Graf at 2020-09-25T14:39:56-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - ba2202a5 by Sebastian Graf at 2020-09-25T14:39:56-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - c1ad216e by Sven Tennie at 2020-09-25T14:39:57-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 4b0beb7d by Arnaud Spiwack at 2020-09-25T14:40:04-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 233b1d8d by Sylvain Henry at 2020-09-25T14:40:08-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - c015c692 by Sylvain Henry at 2020-09-25T14:40:08-04:00 Bignum: implement extended GCD (#18427) - - - - - 7d74a9ab by Krzysztof Gogolewski at 2020-09-25T14:40:10-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 41baa79b by Krzysztof Gogolewski at 2020-09-25T14:40:13-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Unfold.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/defer_type_errors.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/safe_haskell.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/typed_holes.rst - docs/users_guide/using-optimisation.rst - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - rts/Printer.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a14444526ad8cc6553770b00505ed7e8035dd767...41baa79bec32156c81a707c5f0aebae862af6d18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a14444526ad8cc6553770b00505ed7e8035dd767...41baa79bec32156c81a707c5f0aebae862af6d18 You're receiving 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 25 19:12:22 2020 From: gitlab at gitlab.haskell.org (David Eichmann) Date: Fri, 25 Sep 2020 15:12:22 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 2 commits: Add documentation to StgStack Message-ID: <5f6e4116e1624_80b3f84a02f443c146246da@gitlab.haskell.org.mail> David Eichmann pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: f7890ab3 by David Eichmann at 2020-09-25T20:04:48+01:00 Add documentation to StgStack - - - - - 8edefcf9 by David Eichmann at 2020-09-25T20:07:04+01:00 Remove unneeded local variables in unpackClosure# primop - - - - - 2 changed files: - includes/rts/storage/TSO.h - rts/PrimOps.cmm Changes: ===================================== includes/rts/storage/TSO.h ===================================== @@ -242,10 +242,23 @@ typedef struct StgTSO_ { typedef struct StgStack_ { StgHeader header; - StgWord32 stack_size; // stack size in *words* - StgWord8 dirty; // non-zero => dirty + + /* Size of the `stack` field in *words*. This is unaffected by how much of + * the stack space is used nor if more stack space is liked to by an + * UNDERFLOW_FRAME. + */ + StgWord32 stack_size; + + StgWord32 dirty; // non-zero => dirty StgWord8 marking; // non-zero => someone is currently marking the stack - StgPtr sp; // current stack pointer + + /* Pointer to the "top" of the stack i.e. the most recently written address. + * The stack is filled downwards, so the "top" of the stack starts with `sp + * = stack + stack_size` and is decremented as the stack fills with data. + * The memory in `stack` strictly less than `sp` is free stack space. + * See comment on "Invariants" below. + */ + StgPtr sp; StgWord stack[]; } StgStack; ===================================== rts/PrimOps.cmm ===================================== @@ -2371,11 +2371,11 @@ stg_unpackClosurezh ( P_ closure ) clos = UNTAG(closure); W_ len; - // The array returned is the raw data for the entire closure. + // The array returned, dat_arr, is the raw data for the entire closure. // The length is variable based upon the closure type, ptrs, and non-ptrs (len) = foreign "C" heap_view_closureSize(clos "ptr"); - W_ ptrs_arr_sz, ptrs_arr_cards, dat_arr_sz; + W_ dat_arr_sz; dat_arr_sz = SIZEOF_StgArrBytes + WDS(len); ("ptr" dat_arr) = ccall allocateMightFail(MyCapability() "ptr", BYTES_TO_WDS(dat_arr_sz)); @@ -2396,7 +2396,7 @@ for: W_ ptrArray; - // Follow the pointers + // Collect pointers. ("ptr" ptrArray) = foreign "C" heap_view_closurePtrs(MyCapability() "ptr", clos "ptr"); return (info, dat_arr, ptrArray); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e097c8edfcae9c83f10d69af032d34fd2f950dc...8edefcf9c5389f259567998484f22111ac598945 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e097c8edfcae9c83f10d69af032d34fd2f950dc...8edefcf9c5389f259567998484f22111ac598945 You're receiving 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 25 20:56:32 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Fri, 25 Sep 2020 16:56:32 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] Update HasField tests Message-ID: <5f6e5980ec5eb_80b3f849c23952814651934@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: 9fd7531c by Adam Gundry at 2020-09-25T21:56:12+01:00 Update HasField tests Adapt overloadedrecflds tests and T17355 to new definition of HasField Extend hasfieldrun01 test with partial record field test Update hasfieldfail02 test to check unlifted type case Accept changed T14189 output due to FieldLabel additional field Adjust expected output from dynamic-paper Add hasfieldrun03 test for example from user's guide Metric Increase: T12227 T12707 T13056 T15630 T18304 T9233 T9675 - - - - - 15 changed files: - testsuite/tests/dependent/should_compile/dynamic-paper.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.hs - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr - testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs - testsuite/tests/overloadedrecflds/should_run/all.T - testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stderr - testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs - + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout - testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs - testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/typecheck/should_fail/T17355.hs Changes: ===================================== testsuite/tests/dependent/should_compile/dynamic-paper.stderr ===================================== @@ -12,4 +12,4 @@ Simplifier ticks exhausted simplifier non-termination has been judged acceptable. To see detailed counts use -ddump-simpl-stats - Total ticks: 136961 + Total ticks: 139362 ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs ===================================== @@ -2,7 +2,7 @@ import HasFieldFail01_A (T(MkT)) -import GHC.Records (HasField(..)) +import GHC.Records (HasField, getField) -- This should fail to solve the HasField constraint, because foo is -- not in scope. ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.hs ===================================== @@ -1,10 +1,12 @@ {-# LANGUAGE DataKinds, ExistentialQuantification, MagicHash, RankNTypes, TypeApplications #-} -import GHC.Records (HasField(..)) +import GHC.Prim (Int#) +import GHC.Records (HasField, getField) data T = MkT { foo :: forall a . a -> a } data U = forall b . MkU { bar :: b } +data V = MkV { baz :: Int# } -- This should fail because foo is higher-rank. x = getField @"foo" (MkT id) @@ -13,4 +15,7 @@ x = getField @"foo" (MkT id) -- involves an existential). y = getField @"bar" (MkU True) +-- This should fail because baz is not of kind Type. +z = getField @"baz" (MkV 3#) + main = return () ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail02.stderr ===================================== @@ -1,13 +1,18 @@ -hasfieldfail02.hs:10:5: error: - • No instance for (HasField "foo" T a1) +hasfieldfail02.hs:12:5: error: + • No instance for (HasField "foo" T a2) arising from a use of ‘getField’ • In the expression: getField @"foo" (MkT id) - In an equation for ‘x’: - x = getField @"foo" (MkT id) + In an equation for ‘x’: x = getField @"foo" (MkT id) -hasfieldfail02.hs:14:5: error: - • No instance for (HasField "bar" U a0) +hasfieldfail02.hs:16:5: error: + • No instance for (HasField "bar" U a1) arising from a use of ‘getField’ • In the expression: getField @"bar" (MkU True) In an equation for ‘y’: y = getField @"bar" (MkU True) + +hasfieldfail02.hs:19:5: error: + • No instance for (HasField "baz" V a0) + arising from a use of ‘getField’ + • In the expression: getField @"baz" (MkV 3#) + In an equation for ‘z’: z = getField @"baz" (MkV 3#) ===================================== testsuite/tests/overloadedrecflds/should_fail/hasfieldfail03.hs ===================================== @@ -7,23 +7,23 @@ data T = MkT { foo :: Int, bar :: Int } -- This is far too polymorphic instance HasField "woo" a Bool where - getField = const True + hasField = undefined -- This conflicts with the built-in instance instance HasField "foo" T Int where - getField = foo + hasField = undefined -- So does this instance HasField "bar" T Bool where - getField = const True + hasField = undefined -- This doesn't conflict because there is no "baz" field in T instance HasField "baz" T Bool where - getField = const True + hasField = undefined -- Bool has no fields, so this is okay instance HasField a Bool Bool where - getField = id + hasField = undefined data family V a b c d @@ -32,8 +32,8 @@ data instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) } -- Data families cannot have HasField instances, because they may get -- fields defined later on instance HasField "baz" (V a b c d) Bool where - getField = const True + hasField = undefined -- Function types can have HasField instances, in case it's useful instance HasField "woo" (a -> b) Bool where - getField = const True + hasField = undefined ===================================== testsuite/tests/overloadedrecflds/should_run/all.T ===================================== @@ -14,6 +14,7 @@ test('overloadedlabelsrun03', normal, compile_and_run, ['']) test('overloadedlabelsrun04', [extra_files(['OverloadedLabelsRun04_A.hs']), omit_ways(prof_ways)], multimod_compile_and_run, ['overloadedlabelsrun04', config.ghc_th_way_flags]) -test('hasfieldrun01', normal, compile_and_run, ['']) +test('hasfieldrun01', [exit_code(1)], compile_and_run, ['']) test('hasfieldrun02', normal, compile_and_run, ['']) +test('hasfieldrun03', normal, compile_and_run, ['']) test('T12243', normal, compile_and_run, ['']) ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs ===================================== @@ -6,14 +6,19 @@ , TypeFamilies , TypeApplications #-} +{-# OPTIONS_GHC -dcore-lint #-} -import GHC.Records (HasField(..)) +import GHC.Records (HasField(..), getField, setField) + +data S a where + MkS :: { soo :: Either p q } -> S (p,q) type family B where B = Bool data T = MkT { foo :: Int, bar :: B } data U a b = MkU { baf :: a } + deriving Show data family V a b c d data instance V x Int y [z] = MkVInt { baz :: (x, y, z, Bool) } @@ -22,8 +27,16 @@ data W a where MkW :: { woo :: a } -> W [a] data Eq a => X a = MkX { xoo :: a } + deriving Show data Y a = Eq a => MkY { yoo :: a } +data Z = MkZ1 { partial :: Int, total :: Bool } + | MkZ2 { total :: Bool } + deriving Show + +s :: S ((), Bool) +s = MkS (Right True) + t = MkT 42 True u :: U Char Char @@ -37,15 +50,28 @@ x = MkX True y = MkY True +z = MkZ2 False + -- A virtual foo field for U instance HasField "foo" (U a b) [Char] where - getField _ = "virtual" + hasField r = (const r, "virtual") -main = do print (getField @"foo" t) +main = do print (getField @"soo" s) + print (getField @"foo" t) + print (getField @"foo" (setField @"foo" t 11)) print (getField @"bar" t) + print (getField @"bar" (setField @"bar" t False)) print (getField @"baf" u) + print (setField @"baf" u 'y') print (getField @"foo" u) + print (setField @"foo" u "ignored") print (getField @"baz" v) + print (getField @"baz" (setField @"baz" v (40 :: Int, 'y', False, True))) print (getField @"woo" w) + print (getField @"woo" (setField @"woo" w False)) print (getField @"xoo" x) + print (setField @"xoo" x False) print (getField @"yoo" y) + print (getField @"yoo" (setField @"yoo" y False)) + print (getField @"total" (setField @"total" z True)) + print (setField @"partial" z 42) -- Should throw a "No match" error ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stderr ===================================== @@ -0,0 +1 @@ +hasfieldrun01: No match in record selector partial ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout ===================================== @@ -1,8 +1,18 @@ +Right True 42 +11 True +False 'x' +MkU {baf = 'y'} "virtual" +MkU {baf = 'x'} (42,'x',True,False) +(40,'y',False,True) True +False True +MkX {xoo = False} +True +False True ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs ===================================== @@ -0,0 +1,33 @@ + -- This tests an example included in the GHC user's guide (see hasfield.rst). + -- Please update the user's guide if it needs to be changed! + + {-# LANGUAGE DataKinds #-} + {-# LANGUAGE FlexibleContexts #-} + {-# LANGUAGE GADTs #-} + {-# LANGUAGE PolyKinds #-} + {-# LANGUAGE ScopedTypeVariables #-} + {-# LANGUAGE TypeApplications #-} + {-# LANGUAGE TypeOperators #-} + {-# LANGUAGE UndecidableInstances #-} + + import Data.Kind (Type) + import Data.Proxy (Proxy(..)) + import GHC.Records + + data Record (xs :: [(k, Type)]) where + Nil :: Record '[] + Cons :: Proxy x -> a -> Record xs -> Record ('(x, a) ': xs) + + instance {-# OVERLAPS #-} HasField x (Record ('(x, a) ': xs)) a where + hasField (Cons p v r) = (\v' -> Cons p v' r, v) + instance HasField x (Record xs) a => HasField x (Record ('(y, b) ': xs)) a where + hasField (Cons p v r) = (\v' -> Cons p v (set v'), a) + where + (set,a) = hasField @x r + + r :: Record '[ '("name", String) ] + r = Cons Proxy "R" Nil + + x = getField @"name" (setField @"name" r "S") + + main = print x ===================================== testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout ===================================== @@ -0,0 +1 @@ +"S" ===================================== testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs ===================================== @@ -6,6 +6,7 @@ , MultiParamTypeClasses , OverloadedLabels , ScopedTypeVariables + , StandaloneDeriving , TypeApplications , TypeOperators , UndecidableInstances @@ -15,20 +16,29 @@ import GHC.OverloadedLabels import GHC.Records import GHC.TypeLits import Data.Kind +import Data.Proxy data Label (x :: Symbol) = Label + +instance KnownSymbol x => Show (Label x) where + show _ = "#" ++ symbolVal (Proxy @x) + data Labelled x a = Label x := a + deriving Show data Rec :: forall k. [(k, Type)] -> Type where Nil :: Rec '[] (:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs) +instance Show (Rec '[]) where + show Nil = "Nil" +deriving instance (KnownSymbol x, Show a, Show (Rec xs)) => Show (Rec ('(x, a) ': xs)) infixr 5 :> instance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where - getField ((_ := v) :> _) = v + hasField ((l := v) :> xs) = (\ v' -> (l := v') :> xs, v) instance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where - getField (_ :> vs) = getField @foo vs + hasField (x :> vs) = (\ v -> x :> setField @foo vs v, getField @foo vs) instance y ~ x => IsLabel y (Label x) where fromLabel = Label @@ -44,3 +54,4 @@ y = #bar := 'x' :> undefined main = do print (#foo x) print (#bar x) print (#bar y) + print (setField @"foo" x 11) ===================================== testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.stdout ===================================== @@ -1,3 +1,4 @@ 42 True 'x' +#foo := 11 :> (#bar := True :> Nil) ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -134,6 +134,7 @@ (FieldLabel {FastString: "f"} (False) + (()) {Name: T14189.f}))])) [(AvailTC {Name: T14189.MyType} @@ -142,6 +143,7 @@ [(FieldLabel {FastString: "f"} (False) + (()) {Name: T14189.f})])])]) (Nothing))) ===================================== testsuite/tests/typecheck/should_fail/T17355.hs ===================================== @@ -8,4 +8,4 @@ data Foo = Foo { poly :: forall a. a -> a } instance Generic (forall a . a) instance HasField "myPoly" Foo (forall a. a -> a) where - getField (Foo x) = x + hasField (Foo x) = (undefined, x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fd7531c143e47d4544d215d0731072e9436d4ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fd7531c143e47d4544d215d0731072e9436d4ca You're receiving 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 25 21:36:12 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 17:36:12 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Cabal, directory, process submodules Message-ID: <5f6e62cca7bea_80b3f848cc0551c146556de@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 29371e2a by Ben Gamari at 2020-09-25T17:36:06-04:00 Bump Cabal, directory, process submodules Necessary for recent Win32 bump. - - - - - 7 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -76,7 +76,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 4171a459e9d66ebf71d92368be3d7f55cca3e7e1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29371e2ab53d38b45df23ef9459ea24d32a51217 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29371e2ab53d38b45df23ef9459ea24d32a51217 You're receiving 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 25 21:39:59 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 17:39:59 -0400 Subject: [Git][ghc/ghc][wip/backports] 2 commits: Bump Cabal, haskeline, directory, process submodules Message-ID: <5f6e63af53b5c_80b10bca7cc1465619c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 4c37274a by Ben Gamari at 2020-09-25T17:39:53-04:00 Bump Cabal, haskeline, directory, process submodules To accomodate Win32 2.10.0.0. - - - - - 12957a0b by Ben Gamari at 2020-09-25T17:39:53-04:00 Disable -Wdeprecations for deepseq Use to use of Data.Semigroup.Option for NFData instance. - - - - - 8 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/directory - libraries/haskeline - libraries/process - mk/warnings.mk Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -31,6 +31,7 @@ ghcWarningsArgs = do , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] , package compiler ? pure [ "-Wcpp-undef" ] , package directory ? pure [ "-Wno-unused-imports" ] + , package deepseq ? pure [ "-Wno-deprecations" ] , package ghc ? pure [ "-Wcpp-undef" , "-Wincomplete-uni-patterns" , "-Wincomplete-record-updates" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 5f16b76168f13c6413413386efc44fb1152048d5 +Subproject commit 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit cb1d1a6ead68f0e1b209277e79ec608980e9ac84 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# temporarily turn off deprecations in deepseq due to NFData Option instance. +libraries/deepseq_dist-install_EXTRA_HC_OPTS += -Wno-deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d71fb5b1c5a6ff13d5d23b8c10830313a6e21f7...12957a0b1c74e35f1584b09ba90caa52752be575 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d71fb5b1c5a6ff13d5d23b8c10830313a6e21f7...12957a0b1c74e35f1584b09ba90caa52752be575 You're receiving 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 25 23:06:14 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 25 Sep 2020 19:06:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18747 Message-ID: <5f6e77e697723_80b3f848cda5ed01466192c@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/T18747 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18747 You're receiving 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 26 01:10:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:10:25 -0400 Subject: [Git][ghc/ghc][master] Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f6e950191dc4_80b3f847c7e1be414669457@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -16,6 +16,7 @@ find, unsurprisingly, a Core expression. -} {-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -394,7 +395,9 @@ sizeExpr :: UnfoldingOpts -- Note [Computing the size of an expression] -sizeExpr opts bOMB_OUT_SIZE top_args expr +-- Forcing bOMB_OUT_SIZE early prevents repeated +-- unboxing of the Int argument. +sizeExpr opts !bOMB_OUT_SIZE top_args expr = size_up expr where size_up (Cast e _) = size_up e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b72718953c289b6827e877e14d9f0f3f5c64267 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b72718953c289b6827e877e14d9f0f3f5c64267 You're receiving 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 26 01:11:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:11:01 -0400 Subject: [Git][ghc/ghc][master] 2 commits: ci.sh: Factor out common utilities Message-ID: <5f6e9525afd9e_80b3f84300adf181467168b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1095,6 +1095,41 @@ perf-nofib: paths: - nofib.log +############################################################ +# Ad-hoc performance testing +############################################################ + +perf: + stage: testing + dependencies: + - validate-x86_64-linux-deb9-dwarf + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" + rules: + - if: $CI_MERGE_REQUEST_ID + - if: '$CI_COMMIT_BRANCH == "master"' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + tags: + - x86_64-linux-perf + script: + - root=$(pwd)/ghc + - | + mkdir tmp + tar -xf ghc-x86_64-deb9-linux-dwarf.tar.xz -C tmp + pushd tmp/ghc-*/ + ./configure --prefix=$root + make install + popd + rm -Rf tmp + - export BOOT_HC=$(which ghc) + - export HC=$root/bin/ghc + - .gitlab/ci.sh perf_test + artifacts: + expire_in: 12 week + when: always + paths: + - out + + ############################################################ # Documentation deployment via GitLab Pages ############################################################ ===================================== .gitlab/ci.sh ===================================== @@ -10,54 +10,12 @@ hackage_index_state="2020-09-14T19:30:43Z" MIN_HAPPY_VERSION="1.20" MIN_ALEX_VERSION="3.2" -# Colors -BLACK="0;30" -GRAY="1;30" -RED="0;31" -LT_RED="1;31" -BROWN="0;33" -LT_BROWN="1;33" -GREEN="0;32" -LT_GREEN="1;32" -BLUE="0;34" -LT_BLUE="1;34" -PURPLE="0;35" -LT_PURPLE="1;35" -CYAN="0;36" -LT_CYAN="1;36" -WHITE="1;37" -LT_GRAY="0;37" - -# GitLab Pipelines log section delimiters -# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 -start_section() { - name="$1" - echo -e "section_start:$(date +%s):$name\015\033[0K" -} - -end_section() { - name="$1" - echo -e "section_end:$(date +%s):$name\015\033[0K" -} - -echo_color() { - local color="$1" - local msg="$2" - echo -e "\033[${color}m${msg}\033[0m" -} - -error() { echo_color "${RED}" "$1"; } -warn() { echo_color "${LT_BROWN}" "$1"; } -info() { echo_color "${LT_BLUE}" "$1"; } - -fail() { error "error: $1"; exit 1; } - -function run() { - info "Running $*..." - "$@" || ( error "$* failed"; return 1; ) -} - TOP="$(pwd)" +if [ ! -d "$TOP/.gitlab" ]; then + echo "This script expects to be run from the root of a ghc checkout" +fi + +source $TOP/.gitlab/common.sh function setup_locale() { # Musl doesn't provide locale support at all... @@ -437,6 +395,34 @@ function test_hadrian() { --test-compiler="$TOP"/_build/install/bin/ghc } +function cabal_test() { + if [ -z "$OUT" ]; then + fail "OUT not set" + fi + + start_section "Cabal test: $OUT" + mkdir -p "$OUT" + run "$HC" \ + -hidir tmp -odir tmp -fforce-recomp \ + -ddump-to-file -dumpdir "$OUT/dumps" -ddump-timings \ + +RTS --machine-readable "-t$OUT/rts.log" -RTS \ + -package mtl -ilibraries/Cabal/Cabal libraries/Cabal/Cabal/Setup.hs \ + $@ + rm -Rf tmp + end_section "Cabal test: $OUT" +} + +function run_perf_test() { + if [ -z "$HC" ]; then + fail "HC not set" + fi + + mkdir -p out + OUT=out/Cabal-O0 cabal_test -O0 + OUT=out/Cabal-O1 cabal_test -O1 + OUT=out/Cabal-O2 cabal_test -O2 +} + function clean() { rm -R tmp run "$MAKE" --quiet clean || true @@ -507,6 +493,7 @@ case $1 in push_perf_notes exit $res ;; run_hadrian) run_hadrian $@ ;; + perf_test) run_perf_test ;; clean) clean ;; shell) shell $@ ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/common.sh ===================================== @@ -0,0 +1,50 @@ +# Common bash utilities +# ---------------------- + +# Colors +BLACK="0;30" +GRAY="1;30" +RED="0;31" +LT_RED="1;31" +BROWN="0;33" +LT_BROWN="1;33" +GREEN="0;32" +LT_GREEN="1;32" +BLUE="0;34" +LT_BLUE="1;34" +PURPLE="0;35" +LT_PURPLE="1;35" +CYAN="0;36" +LT_CYAN="1;36" +WHITE="1;37" +LT_GRAY="0;37" + +# GitLab Pipelines log section delimiters +# https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 +start_section() { + name="$1" + echo -e "section_start:$(date +%s):$name\015\033[0K" +} + +end_section() { + name="$1" + echo -e "section_end:$(date +%s):$name\015\033[0K" +} + +echo_color() { + local color="$1" + local msg="$2" + echo -e "\033[${color}m${msg}\033[0m" +} + +error() { echo_color "${RED}" "$1"; } +warn() { echo_color "${LT_BROWN}" "$1"; } +info() { echo_color "${LT_BLUE}" "$1"; } + +fail() { error "error: $1"; exit 1; } + +function run() { + info "Running $*..." + "$@" || ( error "$* failed"; return 1; ) +} + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b72718953c289b6827e877e14d9f0f3f5c64267...5b78e8658c3f5042967cbe9d30a5a630946c4fd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b72718953c289b6827e877e14d9f0f3f5c64267...5b78e8658c3f5042967cbe9d30a5a630946c4fd7 You're receiving 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 26 01:11:40 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:11:40 -0400 Subject: [Git][ghc/ghc][master] Stop removing definitions of record fields in GHC.Iface.Ext.Ast Message-ID: <5f6e954c8a861_80b7647d6c146758ea@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 1 changed file: - compiler/GHC/Iface/Ext/Ast.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Driver.Types import GHC.Unit.Module ( ModuleName, ml_hs_file ) import GHC.Utils.Monad ( concatMapM, liftIO ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique ) +import GHC.Types.Name ( Name, nameSrcSpan, nameUnique ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) @@ -52,7 +52,7 @@ import GHC.Core.InstEnv import GHC.Builtin.Types ( mkListTy, mkSumTy ) import GHC.Tc.Types import GHC.Tc.Types.Evidence -import GHC.Types.Var ( Id, Var, EvId, setVarName, varName, varType, varUnique ) +import GHC.Types.Var ( Id, Var, EvId, varName, setVarName, varType, varUnique ) import GHC.Types.Var.Env import GHC.Builtin.Uniques import GHC.Iface.Make ( mkIfaceExports ) @@ -1276,26 +1276,22 @@ instance ( ToHie (RFContext (Located label)) , toHie expr ] -removeDefSrcSpan :: Name -> Name -removeDefSrcSpan n = setNameLoc n noSrcSpan - instance ToHie (RFContext (Located (FieldOcc GhcRn))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc name _ -> - [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name) + [ toHie $ C (RecField c rhs) (L nspan name) ] instance ToHie (RFContext (Located (FieldOcc GhcTc))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of FieldOcc var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous name _ -> - [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name + [ toHie $ C (RecField c rhs) $ L nspan name ] Ambiguous _name _ -> [ ] @@ -1303,13 +1299,11 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of Unambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] Ambiguous var _ -> - let var' = setVarName var (removeDefSrcSpan $ varName var) - in [ toHie $ C (RecField c rhs) (L nspan var') - ] + [ toHie $ C (RecField c rhs) (L nspan var) + ] instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29885f076219d878d2c976e78b7960a1a5938a96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29885f076219d878d2c976e78b7960a1a5938a96 You're receiving 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 26 01:12:15 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:12:15 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Drop Darwin cleanup job Message-ID: <5f6e956fef424_80b3f8442abcf10146786ba@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -21,7 +21,6 @@ stages: - quick-build # A very quick smoke-test to weed out broken commits - build # A quick smoke-test to weed out broken commits - full-build # Build all the things - - cleanup # See Note [Cleanup after the shell executor] - packaging # Source distribution, etc. - testing # head.hackage correctness and compiler performance testing - deploy # push documentation @@ -923,44 +922,6 @@ release-x86_64-windows-integer-simple: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" -############################################################ -# Cleanup -############################################################ - -# Note [Cleaning up after shell executor] -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# -# As noted in [1], gitlab-runner's shell executor doesn't clean up its working -# directory after builds. Unfortunately, we are forced to use the shell executor -# on Darwin. To avoid running out of disk space we add a stage at the end of -# the build to remove the /.../GitLabRunner/builds directory. Since we only run a -# single build at a time on Darwin this should be safe. -# -# We used to have a similar cleanup job on Windows as well however it ended up -# being quite fragile as we have multiple Windows builders yet there is no -# guarantee that the cleanup job is run on the same machine as the build itself -# was run. Consequently we were forced to instead handle cleanup with a separate -# cleanup cron job on Windows. -# -# [1] https://gitlab.com/gitlab-org/gitlab-runner/issues/3856 - -# See Note [Cleanup after shell executor] -cleanup-darwin: - stage: cleanup - tags: - - x86_64-darwin - when: always - dependencies: [] - before_script: - - echo "Time to clean up" - script: - - echo "Let's go" - after_script: - - BUILD_DIR=$CI_PROJECT_DIR - - echo "Cleaning $BUILD_DIR" - - cd $HOME - - rm -Rf $BUILD_DIR/* - - exit 0 ############################################################ # Packaging View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d6519d9e8604d067f4a4f760e4bc3403727a498 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d6519d9e8604d067f4a4f760e4bc3403727a498 You're receiving 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 26 01:12:52 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:12:52 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Add regression tests for #18371 Message-ID: <5f6e9594dba15_80b3f8494d02c78146851e8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 6 changed files: - testsuite/tests/pmcheck/should_compile/T17218.stderr - + testsuite/tests/pmcheck/should_compile/T18371.hs - + testsuite/tests/pmcheck/should_compile/T18371b.hs - + testsuite/tests/pmcheck/should_compile/T18609.hs - + testsuite/tests/pmcheck/should_compile/T18609.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== testsuite/tests/pmcheck/should_compile/T17218.stderr ===================================== @@ -1,6 +1,4 @@ T17218.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive - In an equation for ‘f’: - Patterns not matched: - C + In an equation for ‘f’: Patterns not matched: P ===================================== testsuite/tests/pmcheck/should_compile/T18371.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module Bug where + +import Data.Kind +import Unsafe.Coerce + +type family Sing :: k -> Type + +class SingI a where + sing :: Sing a + +data SingInstance :: forall k. k -> Type where + SingInstance :: SingI a => SingInstance a + +newtype DI (a :: k) = Don'tInstantiate (SingI a => SingInstance a) + +singInstance :: forall k (a :: k). Sing a -> SingInstance a +singInstance s = with_sing_i SingInstance + where + with_sing_i :: (SingI a => SingInstance a) -> SingInstance a + with_sing_i si = unsafeCoerce (Don'tInstantiate si) s + +{-# COMPLETE Sing #-} +pattern Sing :: forall k (a :: k). () => SingI a => Sing a +pattern Sing <- (singInstance -> SingInstance) + where Sing = sing + +----- + +data SBool :: Bool -> Type where + SFalse :: SBool False + STrue :: SBool True +type instance Sing = SBool + +f :: SBool b -> () +f Sing = () + +g :: Sing (b :: Bool) -> () +g Sing = () ===================================== testsuite/tests/pmcheck/should_compile/T18371b.hs ===================================== @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +module Lib where + +type family T + +pattern P :: T +pattern P <- _ +{-# COMPLETE P #-} + +data U = U +type instance T = U + +f :: U -> () +f P = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns, GADTs, DataKinds, KindSignatures, EmptyCase #-} + +-- | All examples from https://arxiv.org/abs/1702.02281 +module GarrigueLeNormand where + +import Data.Kind + +data N = Z | S N + +data Plus :: N -> N -> N -> Type where + PlusO :: Plus Z a a + PlusS :: !(Plus a b c) -> Plus (S a) b (S c) + +data SMaybe a = SJust !a | SNothing + +trivial :: SMaybe (Plus (S Z) Z Z) -> () +trivial SNothing = () + +trivial2 :: Plus (S Z) Z Z -> () +trivial2 x = case x of {} + +easy :: SMaybe (Plus Z (S Z) Z) -> () +easy SNothing = () + +easy2 :: Plus Z (S Z) Z -> () +easy2 x = case x of {} + +harder :: SMaybe (Plus (S Z) (S Z) (S Z)) -> () +harder SNothing = () + +harder2 :: Plus (S Z) (S Z) (S Z) -> () +harder2 x = case x of {} + +invZero :: Plus a b c -> Plus c d Z -> () +invZero !_ !_ | False = () +invZero PlusO PlusO = () + +data T a where + A :: T Int + B :: T Bool + C :: T Char + D :: T Float + +data U a b c d where + U :: U Int Int Int Int + +f :: T a -> T b -> T c -> T d + -> U a b c d + -> () +f !_ !_ !_ !_ !_ | False = () +f A A A A U = () + +g :: T a -> T b -> T c -> T d + -> T e -> T f -> T g -> T h + -> U a b c d + -> U e f g h + -> () +g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = () +g A A A A A A A A U U = () ===================================== testsuite/tests/pmcheck/should_compile/T18609.stderr ===================================== @@ -0,0 +1,13 @@ + +T18609.hs:36:25: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘invZero’: invZero !_ !_ | False = ... + +T18609.hs:51:20: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f !_ !_ !_ !_ !_ | False = ... + +T18609.hs:59:35: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: + g !_ !_ !_ !_ !_ !_ !_ !_ !_ !_ | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -96,7 +96,7 @@ test('T17215', expect_broken(17215), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17216', expect_broken(17216), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17218', expect_broken(17218), compile, +test('T17218', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17219', expect_broken(17219), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) @@ -140,12 +140,18 @@ test('T18273', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18341', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18371b', 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('T18609', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18670', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18708', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d6519d9e8604d067f4a4f760e4bc3403727a498...4a1b89a40d553213c9722207608a07f8a4c07545 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d6519d9e8604d067f4a4f760e4bc3403727a498...4a1b89a40d553213c9722207608a07f8a4c07545 You're receiving 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 26 01:13:27 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:13:27 -0400 Subject: [Git][ghc/ghc][master] Print RET_BIG stack closures Message-ID: <5f6e95b79882f_80b3f843987e1941468787d@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: Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). [...] 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: Marge Bot Subject: [Git][ghc/ghc][master] Print RET_BIG stack closures Date: Fri, 25 Sep 2020 21:13:27 -0400 Size: 67845 URL: From gitlab at gitlab.haskell.org Sat Sep 26 01:14:05 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:14:05 -0400 Subject: [Git][ghc/ghc][master] Pattern guards BindStmt always use multiplicity Many Message-ID: <5f6e95ddbb9f2_80b3f8458012d74146917b4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 4 changed files: - compiler/GHC/Tc/Gen/Match.hs - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr - testsuite/tests/linear/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -397,7 +397,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferRhoNC rhs + = do { -- The Many on the next line and the unrestricted on the line after + -- are linked. These must be the same multiplicity. Consider + -- x <- rhs -> u + -- + -- The multiplicity of x in u must be the same as the multiplicity at + -- which the rhs has been consumed. When solving #18738, we want these + -- two multiplicity to still be the same. + (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module LinearPatternGuardWildcard where + +-- See #18439 + +unsafeConsume :: a #-> () +unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr ===================================== @@ -0,0 +1,5 @@ + +LinearPatternGuardWildcard.hs:7:15: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -27,3 +27,4 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) +test('LinearPatternGuardWildcard', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2707c4eae4cf99e6da2709e128f560d91e468357 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2707c4eae4cf99e6da2709e128f560d91e468357 You're receiving 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 26 01:14:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:14:46 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Bignum: refactor backend modules Message-ID: <5f6e9606380aa_80b3f849c3889ec14694058@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 17 changed files: - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - testsuite/tests/lib/integer/all.T - + testsuite/tests/lib/integer/gcdeInteger.hs - + testsuite/tests/lib/integer/gcdeInteger.stdout - testsuite/tests/lib/integer/integerGcdExt.hs Changes: ===================================== libraries/ghc-bignum/cbits/gmp_wrappers.c ===================================== @@ -280,30 +280,32 @@ integer_gmp_mpn_gcd(mp_limb_t r[], /* wraps mpz_gcdext() * * Set g={g0,gn} to the greatest common divisor of x={x0,xn} and - * y={y0,yn}, and in addition set s={s0,sn} to coefficient - * satisfying x*s + y*t = g. - * - * The g0 array is zero-padded (so that gn is fixed). + * y={y0,yn}, and in addition set s={s0,sn} and t={t0,tn} to + * coefficients satisfying x*s + y*t = g. * * g0 must have space for exactly gn=min(xn,yn) limbs. * s0 must have space for at least yn limbs. + * t0 must have space for at least xn limbs. + * + * Actual sizes are returned by pointers. * - * return value: signed 'sn' of s={s0,sn} where |sn| >= 1 */ -mp_size_t -integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], +void +integer_gmp_gcdext(mp_limb_t s0[], int32_t * ssn, + mp_limb_t t0[], int32_t * stn, + mp_limb_t g0[], int32_t * gn, const mp_limb_t x0[], const mp_size_t xn, const mp_limb_t y0[], const mp_size_t yn) { - const mp_size_t gn0 = mp_size_minabs(xn, yn); const mpz_t x = CONST_MPZ_INIT(x0, mp_limb_zero_p(x0,xn) ? 0 : xn); const mpz_t y = CONST_MPZ_INIT(y0, mp_limb_zero_p(y0,yn) ? 0 : yn); - mpz_t g, s; + mpz_t g, s, t; mpz_init (g); mpz_init (s); + mpz_init (t); - mpz_gcdext (g, s, NULL, x, y); + mpz_gcdext (g, s, t, x, y); // g must be positive (0 <= gn). // According to the docs for mpz_gcdext(), we have: @@ -311,28 +313,31 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], // --> g < min(|y|, |x|) // --> gn <= min(yn, xn) // <-> gn <= gn0 - const mp_size_t gn = g[0]._mp_size; - assert(0 <= gn && gn <= gn0); - memset(g0, 0, gn0*sizeof(mp_limb_t)); - memcpy(g0, g[0]._mp_d, gn*sizeof(mp_limb_t)); + const mp_size_t gn0 = mp_size_minabs(xn, yn); + *gn = g[0]._mp_size; + assert(0 <= *gn && *gn <= gn0); + memcpy(g0, g[0]._mp_d, *gn * sizeof(mp_limb_t)); mpz_clear (g); // According to the docs for mpz_gcdext(), we have: // |s| < |y| / 2g // --> |s| < |y| (note g > 0) // --> sn <= yn - const mp_size_t ssn = s[0]._mp_size; - const mp_size_t sn = mp_size_abs(ssn); + *ssn = s[0]._mp_size; + const mp_size_t sn = mp_size_abs(*ssn); assert(sn <= mp_size_abs(yn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); - if (!sn) { - s0[0] = 0; - return 1; - } - - return ssn; + // According to the docs for mpz_gcdext(), we have: + // |t| < |x| / 2g + // --> |t| < |x| (note g > 0) + // --> st <= xn + *stn = t[0]._mp_size; + const mp_size_t tn = mp_size_abs(*stn); + assert(tn <= mp_size_abs(xn)); + memcpy(t0, t[0]._mp_d, tn*sizeof(mp_limb_t)); + mpz_clear (t); } /* Truncating (i.e. rounded towards zero) integer division-quotient of MPN */ ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -66,15 +66,12 @@ library default-language: Haskell2010 other-extensions: BangPatterns - CApiFFI CPP - DeriveDataTypeable ExplicitForAll GHCForeignImportPrim MagicHash NegativeLiterals NoImplicitPrelude - StandaloneDeriving UnboxedTuples UnliftedFFITypes ForeignFunctionInterface @@ -97,14 +94,14 @@ library if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: - GHC.Num.BigNat.GMP + GHC.Num.Backend.GMP c-sources: cbits/gmp_wrappers.c if flag(ffi) cpp-options: -DBIGNUM_FFI other-modules: - GHC.Num.BigNat.FFI + GHC.Num.Backend.FFI if flag(native) cpp-options: -DBIGNUM_NATIVE @@ -112,13 +109,15 @@ library if flag(check) cpp-options: -DBIGNUM_CHECK other-modules: - GHC.Num.BigNat.Check + GHC.Num.Backend.Check exposed-modules: GHC.Num.Primitives GHC.Num.WordArray GHC.Num.BigNat - GHC.Num.BigNat.Native + GHC.Num.Backend + GHC.Num.Backend.Selected + GHC.Num.Backend.Native GHC.Num.Natural GHC.Num.Integer ===================================== libraries/ghc-bignum/src/GHC/Num/Backend.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +module GHC.Num.Backend + ( module Backend + ) +where + +#if defined(BIGNUM_CHECK) +import GHC.Num.Backend.Check as Backend +#else +import GHC.Num.Backend.Selected as Backend +#endif + ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs ===================================== @@ -10,25 +10,18 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Check Native implementation against another backend -module GHC.Num.BigNat.Check where +module GHC.Num.Backend.Check where import GHC.Prim import GHC.Types import GHC.Num.WordArray import GHC.Num.Primitives -import qualified GHC.Num.BigNat.Native as Native +import {-# SOURCE #-} GHC.Num.Integer +import qualified GHC.Num.Backend.Native as Native +import qualified GHC.Num.Backend.Selected as Other #if defined(BIGNUM_NATIVE) -#error You can't validate Native backed against itself. Choose another backend (e.g. gmp, ffi) - -#elif defined(BIGNUM_FFI) -import qualified GHC.Num.BigNat.FFI as Other - -#elif defined(BIGNUM_GMP) -import qualified GHC.Num.BigNat.GMP as Other - -#else -#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)` +#error You can't validate Native backend against itself. Choose another backend (e.g. gmp, ffi) #endif default () @@ -461,3 +454,18 @@ bignat_powmod_words b e m = in case gr `eqWord#` nr of 1# -> gr _ -> unexpectedValue_Word# (# #) + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = + let + !(# g0,x0,y0 #) = Other.integer_gcde a b + !(# g1,x1,y1 #) = Native.integer_gcde a b + in if isTrue# (integerEq# x0 x1 + &&# integerEq# y0 y1 + &&# integerEq# g0 g1) + then (# g0, x0, y0 #) + else case unexpectedValue of + !_ -> (# integerZero, integerZero, integerZero #) ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs ===================================== @@ -13,12 +13,13 @@ -- that replace bignat foreign calls with calls to the native platform bignat -- library (e.g. JavaScript's BigInt). You can also link an extra object -- providing the implementation. -module GHC.Num.BigNat.FFI where +module GHC.Num.Backend.FFI where import GHC.Prim import GHC.Types import GHC.Num.WordArray import GHC.Num.Primitives +import qualified GHC.Num.Backend.Native as Native default () @@ -579,3 +580,19 @@ bignat_powmod_words = ghc_bignat_powmod_words foreign import ccall unsafe ghc_bignat_powmod_words :: Word# -> Word# -> Word# -> Word# + +-- | Return extended GCD of two non-zero integers. +-- +-- I.e. integer_gcde a b returns (g,x,y) so that ax + by = g +-- +-- Input: a and b are non zero. +-- Output: g must be > 0 +-- +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde = Native.integer_gcde + -- for now we use Native's implementation. If some FFI backend user needs a + -- specific implementation, we'll need to determine a prototype to pass and + -- return BigNat signs and sizes via FFI. ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs ===================================== @@ -8,12 +8,15 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Backend based on the GNU GMP library. -- -- This has been adapted from the legacy `integer-gmp` package written by -- Herbert Valerio Riedel. -module GHC.Num.BigNat.GMP where +module GHC.Num.Backend.GMP where #include "MachDeps.h" #include "WordSize.h" @@ -22,6 +25,9 @@ import GHC.Num.WordArray import GHC.Num.Primitives import GHC.Prim import GHC.Types +import GHC.Magic (runRW#) +import {-# SOURCE #-} GHC.Num.Integer +import {-# SOURCE #-} GHC.Num.BigNat default () @@ -352,6 +358,70 @@ bignat_powmod r b e m s = case ioInt# (integer_gmp_powm# r b (wordArraySize# b) e (wordArraySize# e) m (wordArraySize# m)) s of (# s', n #) -> mwaSetSize# r (narrowGmpSize# n) s' +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = case runRW# io of (# _, a #) -> a + where + !(# sa, ba #) = integerToBigNatSign# a + !(# sb, bb #) = integerToBigNatSign# b + !sza = bigNatSize# ba + !szb = bigNatSize# bb + -- signed sizes of a and b + !ssa = case sa of + 0# -> sza + _ -> negateInt# sza + !ssb = case sb of + 0# -> szb + _ -> negateInt# szb + + -- gcd(a,b) < min(a,b) + !g_init_sz = minI# sza szb + + -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext + -- a*x + b*y = g + -- abs(x) < abs(b) / (2 g) < abs(b) + -- abs(y) < abs(a) / (2 g) < abs(a) + !x_init_sz = szb + !y_init_sz = sza + + io s = + -- allocate output arrays + case newWordArray# g_init_sz s of { (# s, mbg #) -> + case newWordArray# x_init_sz s of { (# s, mbx #) -> + case newWordArray# y_init_sz s of { (# s, mby #) -> + -- allocate space to return sizes (3x4 = 12) + case newPinnedByteArray# 12# s of { (# s, mszs #) -> + case unsafeFreezeByteArray# mszs s of { (# s, szs #) -> + let !ssx_ptr = byteArrayContents# szs in + let !ssy_ptr = ssx_ptr `plusAddr#` 4# in + let !sg_ptr = ssy_ptr `plusAddr#` 4# in + -- call GMP + case ioVoid (integer_gmp_gcdext# mbx ssx_ptr mby ssy_ptr mbg sg_ptr ba ssa bb ssb) s of { s -> + -- read sizes + case readInt32OffAddr# ssx_ptr 0# s of { (# s, ssx #) -> + case readInt32OffAddr# ssy_ptr 0# s of { (# s, ssy #) -> + case readInt32OffAddr# sg_ptr 0# s of { (# s, sg #) -> + case touch# szs s of { s -> + -- shrink x, y and g to their actual sizes and freeze them + let !sx = absI# ssx in + let !sy = absI# ssy in + case mwaSetSize# mbx sx s of { s -> + case mwaSetSize# mby sy s of { s -> + case mwaSetSize# mbg sg s of { s -> + + -- return x, y and g as Integer + case unsafeFreezeByteArray# mbx s of { (# s, bx #) -> + case unsafeFreezeByteArray# mby s of { (# s, by #) -> + case unsafeFreezeByteArray# mbg s of { (# s, bg #) -> + + (# s, (# integerFromBigNat# bg + , integerFromBigNatSign# (ssx <# 0#) bx + , integerFromBigNatSign# (ssy <# 0#) by #) #) + }}}}}}}}}}}}}}}} + + ---------------------------------------------------------------------- -- FFI ccall imports @@ -366,10 +436,13 @@ foreign import ccall unsafe "integer_gmp_mpn_gcd" c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO GmpSize -foreign import ccall unsafe "integer_gmp_gcdext" - integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s - -> ByteArray# -> GmpSize# - -> ByteArray# -> GmpSize# -> IO GmpSize +foreign import ccall unsafe "integer_gmp_gcdext" integer_gmp_gcdext# + :: MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# + -> IO () -- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, -- mp_limb_t s2limb) ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs ===================================== @@ -9,7 +9,7 @@ {-# LANGUAGE BinaryLiterals #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -module GHC.Num.BigNat.Native where +module GHC.Num.Backend.Native where #include "MachDeps.h" #include "WordSize.h" @@ -17,9 +17,11 @@ module GHC.Num.BigNat.Native where #if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) import {-# SOURCE #-} GHC.Num.BigNat import {-# SOURCE #-} GHC.Num.Natural +import {-# SOURCE #-} GHC.Num.Integer #else import GHC.Num.BigNat import GHC.Num.Natural +import GHC.Num.Integer #endif import GHC.Num.WordArray import GHC.Num.Primitives @@ -717,3 +719,21 @@ bignat_powmod_words b e m = bignat_powmod_word (wordArrayFromWord# b) (wordArrayFromWord# e) m + + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = f (# a,integerOne,integerZero #) (# b,integerZero,integerOne #) + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + + f old@(# old_g, old_s, old_t #) new@(# g, s, t #) + | integerIsZero g = fix old + | True = case integerQuotRem# old_g g of + !(# q, r #) -> f new (# r , old_s `integerSub` (q `integerMul` s) + , old_t `integerSub` (q `integerMul` t) #) ===================================== libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +-- +-- We need this module in addition to GHC.Num.Backend to avoid module loops with +-- Check backend. +module GHC.Num.Backend.Selected + ( module Backend + ) +where + +#if defined(BIGNUM_NATIVE) +import GHC.Num.Backend.Native as Backend + +#elif defined(BIGNUM_FFI) +import GHC.Num.Backend.FFI as Backend + +#elif defined(BIGNUM_GMP) +import GHC.Num.Backend.GMP as Backend + +#else +#error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native, ffi)` +#endif ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs ===================================== @@ -23,27 +23,12 @@ import GHC.Classes import GHC.Magic import GHC.Num.Primitives import GHC.Num.WordArray +import GHC.Num.Backend #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 #endif -#if defined(BIGNUM_CHECK) -import GHC.Num.BigNat.Check - -#elif defined(BIGNUM_NATIVE) -import GHC.Num.BigNat.Native - -#elif defined(BIGNUM_FFI) -import GHC.Num.BigNat.FFI - -#elif defined(BIGNUM_GMP) -import GHC.Num.BigNat.GMP - -#else -#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)` -#endif - default () -- | A BigNat ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot ===================================== @@ -10,6 +10,7 @@ import GHC.Prim type BigNat# = WordArray# data BigNat = BN# { unBigNat :: BigNat# } +bigNatSize# :: BigNat# -> Int# bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# bigNatMulWord# :: BigNat# -> Word# -> BigNat# bigNatRem :: BigNat# -> BigNat# -> BigNat# ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} -- | -- Module : GHC.Num.Integer @@ -31,6 +32,7 @@ import GHC.Magic import GHC.Num.Primitives import GHC.Num.BigNat import GHC.Num.Natural +import qualified GHC.Num.Backend as Backend #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 @@ -113,6 +115,17 @@ integerFromBigNatSign# !sign !bn | True = integerFromBigNatNeg# bn +-- | Convert an Integer into a sign-bit and a BigNat +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerToBigNatSign# = \case + IS x + | isTrue# (x >=# 0#) + -> (# 0#, bigNatFromWord# (int2Word# x) #) + | True + -> (# 1#, bigNatFromWord# (int2Word# (negateInt# x)) #) + IP x -> (# 0#, x #) + IN x -> (# 1#, x #) + -- | Convert an Integer into a BigNat. -- -- Return 0 for negative Integers. @@ -853,7 +866,7 @@ integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) {-# NOINLINE integerDivMod# #-} integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) - = let !q' = integerAdd q (IS -1#) -- TODO: optimize + = let !q' = integerSub q (IS 1#) !r' = integerAdd r d in (# q', r' #) | True = qr @@ -1169,3 +1182,35 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i + + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde# a b` returns (# g,x,y #) where +-- * ax + by = g = |gcd a b| +integerGcde# + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integerGcde# a b + | integerIsZero a && integerIsZero b = (# integerZero, integerZero, integerZero #) + | integerIsZero a = fix (# b , integerZero, integerOne #) + | integerIsZero b = fix (# a , integerOne, integerZero #) + | integerAbs a `integerEq` integerAbs b = fix (# b , integerZero, integerOne #) + | True = Backend.integer_gcde a b + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde a b` returns (g,x,y) where +-- * ax + by = g = |gcd a b| +integerGcde + :: Integer + -> Integer + -> ( Integer, Integer, Integer) +integerGcde a b = case integerGcde# a b of + (# g,x,y #) -> (g,x,y) ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module GHC.Num.Integer where + +import GHC.Types +import GHC.Prim +import {-# SOURCE #-} GHC.Num.BigNat + +data Integer + +integerZero :: Integer +integerOne :: Integer + +integerEq# :: Integer -> Integer -> Int# +integerEq :: Integer -> Integer -> Bool +integerGt :: Integer -> Integer -> Bool +integerIsZero :: Integer -> Bool +integerIsNegative :: Integer -> Bool + +integerSub :: Integer -> Integer -> Integer +integerMul :: Integer -> Integer -> Integer +integerNegate :: Integer -> Integer +integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) +integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) + +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerFromBigNatSign# :: Int# -> BigNat# -> Integer +integerFromBigNat# :: BigNat# -> Integer ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Integer.GMP.Internals -- ** Additional 'Integer' operations , gcdInteger + , gcdExtInteger , lcmInteger , sqrInteger @@ -170,6 +171,12 @@ isValidInteger# = I.integerCheck# gcdInteger :: Integer -> Integer -> Integer gcdInteger = I.integerGcd +{-# DEPRECATED gcdExtInteger "Use integerGcde instead" #-} +gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #) +gcdExtInteger a b = case I.integerGcde# a b of + (# g, s, _t #) -> (# g, s #) + + {-# DEPRECATED lcmInteger "Use integerLcm instead" #-} lcmInteger :: Integer -> Integer -> Integer lcmInteger = I.integerLcm ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -5,11 +5,12 @@ test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'] test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) +test('gcdeInteger', normal, compile_and_run, ['']) test('integerPowMod', [], compile_and_run, ['']) +test('integerGcdExt', [omit_ways(['ghci'])], compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples test('integerImportExport', [omit_ways(['ghci'])], compile_and_run, ['']) # Disable GMP only tests -#test('integerGcdExt', [omit_ways(['ghci'])], compile_and_run, ['']) #test('integerGmpInternals', [], compile_and_run, ['']) ===================================== testsuite/tests/lib/integer/gcdeInteger.hs ===================================== @@ -0,0 +1,114 @@ + +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiWayIf #-} + +module Main (main) where + +import GHC.Base +import GHC.Num.Integer +import Control.Monad +import System.Exit + +main :: IO () +main = do + + let test a b = do + putStrLn $ "GCDE " ++ show a ++ " " ++ show b + let r@(g,x,y) = integerGcde a b + putStrLn $ " -> g = " ++ show g + putStrLn $ " -> x = " ++ show x + putStrLn $ " -> y = " ++ show y + let sign a | a >= 0 = 1 + | otherwise = -1 + let assert text cond term + | not cond = return () + | term = return () + | otherwise = do + putStrLn $ "FAILED: " ++ text + putStrLn $ "a*x + b*y = g" + putStrLn $ "a = " ++ show a + putStrLn $ "b = " ++ show b + putStrLn $ "x = " ++ show x + putStrLn $ "y = " ++ show y + putStrLn $ "g = " ++ show g + putStrLn $ "expected g = " ++ show (abs (integerGcd a b)) + exitFailure + + -- check properties + assert "g >= 0" True (g >= 0) + assert "a*x + b*y = g" True (a*x + b*y == g) + assert "g = abs (gcd a b)" True (g == abs (integerGcd a b)) + + if -- special cases + | a == 0 && b == 0 -> do + assert "a == 0 && b ==0 ==> g == 0" (a == 0 && b == 0) (g == 0) + + | abs a == abs b -> do + assert "abs a == abs b ==> x == 0 && y == sign b && g == abs a" + (abs a == abs b) (x == 0 && y == sign b && g == abs a) + + -- non special cases + | otherwise -> do + assert "b == 0 ==> x=sign a" + (b == 0) + (x == sign a) + + assert "abs b == 2g ==> x=sign a" + (abs b == 2*g) + (x == sign a) + + assert "b /= 0 ==> abs x <= abs b / 2*g" + (b /= 0) + (abs x <= abs b `div` 2 * g) + + assert "a /= 0 ==> abs y <= abs a / 2*g" + (a /= 0) + (abs y <= abs a `div` 2 * g) + + assert "a == 0 ==> y=sign b" + (a == 0) + (y == sign b) + + assert "abs a == 2g ==> y==sign b" + (abs a == 2*g) + (y == sign b) + + assert "x == 0 ==> g == abs b" + (x == 0) + (g == abs b) + + nums = + [ 0 + , 1 + , 7 + , 14 + , 123 + , 1230 + , 123456789456789456789456789456789456789465789465456789465454645789 + , 4 * 123456789456789456789456789456789456789465789465456789465454645789 + , -1 + , -123 + , -123456789456789456789456789456789456789465789465456789465454645789 + , 4567897897897897899789897897978978979789 + , 2988348162058574136915891421498819466320163312926952423791023078876139 + , 2351399303373464486466122544523690094744975233415544072992656881240319 + , 5328841272400314897981163497728751426 + , 32052182750761975518649228050096851724 + ] + + forM_ nums $ \a -> + forM_ nums $ \b -> + test a b + + -- see #15350 + do + let a = 2 + b = 2^65 + 1 + test a b + test a (-b) + test (-a) b + test (-a) (-b) + test b a + test b (-a) + test (-b) a + test (-b) (-a) ===================================== testsuite/tests/lib/integer/gcdeInteger.stdout ===================================== @@ -0,0 +1,1056 @@ +GCDE 0 0 + -> g = 0 + -> x = 0 + -> y = 0 +GCDE 0 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 0 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 0 14 + -> g = 14 + -> x = 0 + -> y = 1 +GCDE 0 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 0 1230 + -> g = 1230 + -> x = 0 + -> y = 1 +GCDE 0 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 0 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 0 + -> y = 1 +GCDE 0 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 0 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 0 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 0 4567897897897897899789897897978978979789 + -> g = 4567897897897897899789897897978978979789 + -> x = 0 + -> y = 1 +GCDE 0 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 0 + -> y = 1 +GCDE 0 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 0 + -> y = 1 +GCDE 0 5328841272400314897981163497728751426 + -> g = 5328841272400314897981163497728751426 + -> x = 0 + -> y = 1 +GCDE 0 32052182750761975518649228050096851724 + -> g = 32052182750761975518649228050096851724 + -> x = 0 + -> y = 1 +GCDE 1 0 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 1 7 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 14 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 123 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 1230 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 1 -123 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 5328841272400314897981163497728751426 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 32052182750761975518649228050096851724 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 7 0 + -> g = 7 + -> x = 1 + -> y = 0 +GCDE 7 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 7 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 7 14 + -> g = 7 + -> x = 1 + -> y = 0 +GCDE 7 123 + -> g = 1 + -> x = -35 + -> y = 2 +GCDE 7 1230 + -> g = 1 + -> x = -527 + -> y = 3 +GCDE 7 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -52910052624338338624052909767195481481199624056624338342337705338 + -> y = 3 +GCDE 7 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 70546736832451118165403879689593975308266165408832451123116940451 + -> y = -1 +GCDE 7 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 7 -123 + -> g = 1 + -> x = -35 + -> y = -2 +GCDE 7 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -52910052624338338624052909767195481481199624056624338342337705338 + -> y = -3 +GCDE 7 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1305113685113685114225685113708279708511 + -> y = 2 +GCDE 7 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1280720640882246058678239180642351199851498562682979610196152748089774 + -> y = -3 +GCDE 7 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -671828372392418424704606441292482884212850066690155449426473394640091 + -> y = 2 +GCDE 7 5328841272400314897981163497728751426 + -> g = 1 + -> x = 2283789116742992099134784356169464897 + -> y = -3 +GCDE 7 32052182750761975518649228050096851724 + -> g = 1 + -> x = -13736649750326560936563954878612936453 + -> y = 3 +GCDE 14 0 + -> g = 14 + -> x = 1 + -> y = 0 +GCDE 14 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 14 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 14 14 + -> g = 14 + -> x = 0 + -> y = 1 +GCDE 14 123 + -> g = 1 + -> x = 44 + -> y = -5 +GCDE 14 1230 + -> g = 2 + -> x = 88 + -> y = -1 +GCDE 14 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -26455026312169169312026454883597740740599812028312169171168852669 + -> y = 3 +GCDE 14 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = 70546736832451118165403879689593975308266165408832451123116940451 + -> y = -2 +GCDE 14 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 14 -123 + -> g = 1 + -> x = 44 + -> y = 5 +GCDE 14 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -26455026312169169312026454883597740740599812028312169171168852669 + -> y = -3 +GCDE 14 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1631392106392106392782106392135349635639 + -> y = -5 +GCDE 14 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 640360320441123029339119590321175599925749281341489805098076374044887 + -> y = -3 +GCDE 14 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 839785465490523030880758051615603605266062583362694311783091743300114 + -> y = -5 +GCDE 14 5328841272400314897981163497728751426 + -> g = 2 + -> x = -380631519457165349855797392694910816 + -> y = 1 +GCDE 14 32052182750761975518649228050096851724 + -> g = 2 + -> x = 2289441625054426822760659146435489409 + -> y = -1 +GCDE 123 0 + -> g = 123 + -> x = 1 + -> y = 0 +GCDE 123 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 123 7 + -> g = 1 + -> x = 2 + -> y = -35 +GCDE 123 14 + -> g = 1 + -> x = -5 + -> y = 44 +GCDE 123 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 123 1230 + -> g = 123 + -> x = 1 + -> y = 0 +GCDE 123 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -49181973035631572216938070596607181973039216941523436453717704420 + -> y = 49 +GCDE 123 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -172638762492421029006394860053396638762505006406980225919172350209 + -> y = 43 +GCDE 123 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 123 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 123 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -49181973035631572216938070596607181973039216941523436453717704420 + -> y = -49 +GCDE 123 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 854159769525623184513558143524524524676 + -> y = -23 +GCDE 123 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1360548756709594729002357069950682033446578418893571835221929206642795 + -> y = -56 +GCDE 123 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -1108789915411877562723862663271333540611451736082126473443691862698687 + -> y = 58 +GCDE 123 5328841272400314897981163497728751426 + -> g = 3 + -> x = 606534778972393565623872268034166829 + -> y = -14 +GCDE 123 32052182750761975518649228050096851724 + -> g = 3 + -> x = 1042347406528844732313796034149491113 + -> y = -4 +GCDE 1230 0 + -> g = 1230 + -> x = 1 + -> y = 0 +GCDE 1230 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 1230 7 + -> g = 1 + -> x = 3 + -> y = -527 +GCDE 1230 14 + -> g = 2 + -> x = -1 + -> y = 88 +GCDE 1230 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 1230 1230 + -> g = 1230 + -> x = 0 + -> y = 1 +GCDE 1230 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -4918197303563157221693807059660718197303921694152343645371770442 + -> y = 49 +GCDE 1230 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = 113620394849663142346069175337468020394857946077152102174711104905 + -> y = -283 +GCDE 1230 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 1230 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 1230 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -4918197303563157221693807059660718197303921694152343645371770442 + -> y = -49 +GCDE 1230 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1741743182206596841464603344839139139448 + -> y = 469 +GCDE 1230 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1358119205358327595557710003754341529815423814574119028373318618773790 + -> y = 559 +GCDE 1230 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 594540799470851589667450497029973674362347396416450574553427878102227 + -> y = -311 +GCDE 1230 5328841272400314897981163497728751426 + -> g = 6 + -> x = 298934998207822543057479903531125080 + -> y = -69 +GCDE 1230 32052182750761975518649228050096851724 + -> g = 6 + -> x = -1928342702078362754780522663176558559 + -> y = 74 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 0 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 1 + -> y = 0 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 7 + -> g = 1 + -> x = 3 + -> y = -52910052624338338624052909767195481481199624056624338342337705338 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 14 + -> g = 1 + -> x = 3 + -> y = -26455026312169169312026454883597740740599812028312169171168852669 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 123 + -> g = 1 + -> x = 49 + -> y = -49181973035631572216938070596607181973039216941523436453717704420 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 1230 + -> g = 1 + -> x = 49 + -> y = -4918197303563157221693807059660718197303921694152343645371770442 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 1 + -> y = 0 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -123 + -> g = 1 + -> x = 49 + -> y = 49181973035631572216938070596607181973039216941523436453717704420 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -142355531505412253555567593395647545708 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 501499981494162622976489092493961483514126808861435716131179868189595 + -> y = -20718328076357217180814970215022985846592184263422313201087532586 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 608000101055682152473830041965606704242079033852469328931798308452101 + -> y = -31922158162609726789179865549911873484290325403318594248193251952 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 5328841272400314897981163497728751426 + -> g = 1 + -> x = -233831227202814412604649442847121617 + -> y = 5417322661629453658993420651614628087475941267504880682551205239 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 32052182750761975518649228050096851724 + -> g = 1 + -> x = 2649042575281623182157985423209129457 + -> y = -10203432759063496909071922280945854833629276496909075027106202353 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 0 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 1 + -> y = 0 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 7 + -> g = 1 + -> x = -1 + -> y = 70546736832451118165403879689593975308266165408832451123116940451 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 14 + -> g = 2 + -> x = -2 + -> y = 70546736832451118165403879689593975308266165408832451123116940451 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 123 + -> g = 1 + -> x = 43 + -> y = -172638762492421029006394860053396638762505006406980225919172350209 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 1230 + -> g = 2 + -> x = -283 + -> y = 113620394849663142346069175337468020394857946077152102174711104905 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -123 + -> g = 1 + -> x = 43 + -> y = 172638762492421029006394860053396638762505006406980225919172350209 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -35588882876353063388891898348911886427 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -621712045141102878484850582251214495701509126016379176914960802671636 + -> y = 102738461380432239608641819241766470942873605202034476264367113203 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 739849851107286659734988146622324199746763566817003350481113797423105 + -> y = -155378947619399183578636655006701330273756114868775383713647897741 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 5328841272400314897981163497728751426 + -> g = 2 + -> x = 1215294704498671518192966153008627048 + -> y = -112622144133530549471469948153560200614513906930447028100352235311 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 32052182750761975518649228050096851724 + -> g = 4 + -> x = 2649042575281623182157985423209129457 + -> y = -40813731036253987636287689123783419334517105987636300108424809412 +GCDE -1 0 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -1 7 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 14 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 123 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 1230 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -1 -123 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 5328841272400314897981163497728751426 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 32052182750761975518649228050096851724 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -123 0 + -> g = 123 + -> x = -1 + -> y = 0 +GCDE -123 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -123 7 + -> g = 1 + -> x = -2 + -> y = -35 +GCDE -123 14 + -> g = 1 + -> x = 5 + -> y = 44 +GCDE -123 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE -123 1230 + -> g = 123 + -> x = -1 + -> y = 0 +GCDE -123 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 49181973035631572216938070596607181973039216941523436453717704420 + -> y = 49 +GCDE -123 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 172638762492421029006394860053396638762505006406980225919172350209 + -> y = 43 +GCDE -123 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -123 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE -123 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 49181973035631572216938070596607181973039216941523436453717704420 + -> y = -49 +GCDE -123 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -854159769525623184513558143524524524676 + -> y = -23 +GCDE -123 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1360548756709594729002357069950682033446578418893571835221929206642795 + -> y = -56 +GCDE -123 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 1108789915411877562723862663271333540611451736082126473443691862698687 + -> y = 58 +GCDE -123 5328841272400314897981163497728751426 + -> g = 3 + -> x = -606534778972393565623872268034166829 + -> y = -14 +GCDE -123 32052182750761975518649228050096851724 + -> g = 3 + -> x = -1042347406528844732313796034149491113 + -> y = -4 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 0 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = -1 + -> y = 0 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 7 + -> g = 1 + -> x = -3 + -> y = -52910052624338338624052909767195481481199624056624338342337705338 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 14 + -> g = 1 + -> x = -3 + -> y = -26455026312169169312026454883597740740599812028312169171168852669 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 123 + -> g = 1 + -> x = -49 + -> y = -49181973035631572216938070596607181973039216941523436453717704420 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 1230 + -> g = 1 + -> x = -49 + -> y = -4918197303563157221693807059660718197303921694152343645371770442 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = -1 + -> y = 0 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -123 + -> g = 1 + -> x = -49 + -> y = 49181973035631572216938070596607181973039216941523436453717704420 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 142355531505412253555567593395647545708 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -501499981494162622976489092493961483514126808861435716131179868189595 + -> y = -20718328076357217180814970215022985846592184263422313201087532586 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -608000101055682152473830041965606704242079033852469328931798308452101 + -> y = -31922158162609726789179865549911873484290325403318594248193251952 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 5328841272400314897981163497728751426 + -> g = 1 + -> x = 233831227202814412604649442847121617 + -> y = 5417322661629453658993420651614628087475941267504880682551205239 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 32052182750761975518649228050096851724 + -> g = 1 + -> x = -2649042575281623182157985423209129457 + -> y = -10203432759063496909071922280945854833629276496909075027106202353 +GCDE 4567897897897897899789897897978978979789 0 + -> g = 4567897897897897899789897897978978979789 + -> x = 1 + -> y = 0 +GCDE 4567897897897897899789897897978978979789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 4567897897897897899789897897978978979789 7 + -> g = 1 + -> x = 2 + -> y = -1305113685113685114225685113708279708511 +GCDE 4567897897897897899789897897978978979789 14 + -> g = 1 + -> x = -5 + -> y = 1631392106392106392782106392135349635639 +GCDE 4567897897897897899789897897978978979789 123 + -> g = 1 + -> x = -23 + -> y = 854159769525623184513558143524524524676 +GCDE 4567897897897897899789897897978978979789 1230 + -> g = 1 + -> x = 469 + -> y = -1741743182206596841464603344839139139448 +GCDE 4567897897897897899789897897978978979789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = -142355531505412253555567593395647545708 +GCDE 4567897897897897899789897897978978979789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = -35588882876353063388891898348911886427 +GCDE 4567897897897897899789897897978978979789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 4567897897897897899789897897978978979789 -123 + -> g = 1 + -> x = -23 + -> y = -854159769525623184513558143524524524676 +GCDE 4567897897897897899789897897978978979789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = 142355531505412253555567593395647545708 +GCDE 4567897897897897899789897897978978979789 4567897897897897899789897897978978979789 + -> g = 4567897897897897899789897897978978979789 + -> x = 0 + -> y = 1 +GCDE 4567897897897897899789897897978978979789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1015458101705415789288140664792006324531958465967800433101537202119645 + -> y = 1552198297064637650702543759558133740654 +GCDE 4567897897897897899789897897978978979789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 683642522828502349233122722282318495240860998440822891959775694494728 + -> y = -1328064203498637654577318574253233256089 +GCDE 4567897897897897899789897897978978979789 5328841272400314897981163497728751426 + -> g = 1 + -> x = 729028905639966888803280268153493563 + -> y = -624925651816157654399317122483041604031 +GCDE 4567897897897897899789897897978978979789 32052182750761975518649228050096851724 + -> g = 1 + -> x = -12910967943414004413956938074429250463 + -> y = 1839998972523827338782593728961148005767 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 0 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 1 + -> y = 0 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 7 + -> g = 1 + -> x = -3 + -> y = 1280720640882246058678239180642351199851498562682979610196152748089774 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 14 + -> g = 1 + -> x = -3 + -> y = 640360320441123029339119590321175599925749281341489805098076374044887 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 123 + -> g = 1 + -> x = -56 + -> y = 1360548756709594729002357069950682033446578418893571835221929206642795 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 1230 + -> g = 1 + -> x = 559 + -> y = -1358119205358327595557710003754341529815423814574119028373318618773790 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -20718328076357217180814970215022985846592184263422313201087532586 + -> y = 501499981494162622976489092493961483514126808861435716131179868189595 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 102738461380432239608641819241766470942873605202034476264367113203 + -> y = -621712045141102878484850582251214495701509126016379176914960802671636 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -123 + -> g = 1 + -> x = -56 + -> y = -1360548756709594729002357069950682033446578418893571835221929206642795 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -20718328076357217180814970215022985846592184263422313201087532586 + -> y = -501499981494162622976489092493961483514126808861435716131179868189595 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1552198297064637650702543759558133740654 + -> y = -1015458101705415789288140664792006324531958465967800433101537202119645 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 0 + -> y = 1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -238164827888328100873319793437342927637138278785737103723156342382925 + -> y = 302679100340807588460107986194035692812415103244388831792688023418704 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 5328841272400314897981163497728751426 + -> g = 1 + -> x = 88969837841661133174308363831195241 + -> y = -49893182739334638874406212208356173614356037934509167748717979955473 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 32052182750761975518649228050096851724 + -> g = 1 + -> x = -2926808101621088968857550652617123241 + -> y = 272877565911469778893036529750941765793334087149670477404511983087875 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 0 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 1 + -> y = 0 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 7 + -> g = 1 + -> x = 2 + -> y = -671828372392418424704606441292482884212850066690155449426473394640091 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 14 + -> g = 1 + -> x = -5 + -> y = 839785465490523030880758051615603605266062583362694311783091743300114 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 123 + -> g = 1 + -> x = 58 + -> y = -1108789915411877562723862663271333540611451736082126473443691862698687 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 1230 + -> g = 1 + -> x = -311 + -> y = 594540799470851589667450497029973674362347396416450574553427878102227 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -31922158162609726789179865549911873484290325403318594248193251952 + -> y = 608000101055682152473830041965606704242079033852469328931798308452101 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -155378947619399183578636655006701330273756114868775383713647897741 + -> y = 739849851107286659734988146622324199746763566817003350481113797423105 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -123 + -> g = 1 + -> x = 58 + -> y = 1108789915411877562723862663271333540611451736082126473443691862698687 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -31922158162609726789179865549911873484290325403318594248193251952 + -> y = -608000101055682152473830041965606704242079033852469328931798308452101 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1328064203498637654577318574253233256089 + -> y = 683642522828502349233122722282318495240860998440822891959775694494728 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 302679100340807588460107986194035692812415103244388831792688023418704 + -> y = -238164827888328100873319793437342927637138278785737103723156342382925 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 0 + -> y = 1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 5328841272400314897981163497728751426 + -> g = 1 + -> x = 1320061761887019753142991170712833225 + -> y = -582489165775607532361449347744188527071103823360367325716372563952699 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 32052182750761975518649228050096851724 + -> g = 1 + -> x = -3459287250911140032199362006422486237 + -> y = 253778836069059554551347740010931350716760250644753514181097821250371 +GCDE 5328841272400314897981163497728751426 0 + -> g = 5328841272400314897981163497728751426 + -> x = 1 + -> y = 0 +GCDE 5328841272400314897981163497728751426 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 5328841272400314897981163497728751426 7 + -> g = 1 + -> x = -3 + -> y = 2283789116742992099134784356169464897 +GCDE 5328841272400314897981163497728751426 14 + -> g = 2 + -> x = 1 + -> y = -380631519457165349855797392694910816 +GCDE 5328841272400314897981163497728751426 123 + -> g = 3 + -> x = -14 + -> y = 606534778972393565623872268034166829 +GCDE 5328841272400314897981163497728751426 1230 + -> g = 6 + -> x = -69 + -> y = 298934998207822543057479903531125080 +GCDE 5328841272400314897981163497728751426 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 5417322661629453658993420651614628087475941267504880682551205239 + -> y = -233831227202814412604649442847121617 +GCDE 5328841272400314897981163497728751426 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = -112622144133530549471469948153560200614513906930447028100352235311 + -> y = 1215294704498671518192966153008627048 +GCDE 5328841272400314897981163497728751426 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 5328841272400314897981163497728751426 -123 + -> g = 3 + -> x = -14 + -> y = -606534778972393565623872268034166829 +GCDE 5328841272400314897981163497728751426 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 5417322661629453658993420651614628087475941267504880682551205239 + -> y = 233831227202814412604649442847121617 +GCDE 5328841272400314897981163497728751426 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -624925651816157654399317122483041604031 + -> y = 729028905639966888803280268153493563 +GCDE 5328841272400314897981163497728751426 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -49893182739334638874406212208356173614356037934509167748717979955473 + -> y = 88969837841661133174308363831195241 +GCDE 5328841272400314897981163497728751426 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -582489165775607532361449347744188527071103823360367325716372563952699 + -> y = 1320061761887019753142991170712833225 +GCDE 5328841272400314897981163497728751426 5328841272400314897981163497728751426 + -> g = 5328841272400314897981163497728751426 + -> x = 0 + -> y = 1 +GCDE 5328841272400314897981163497728751426 32052182750761975518649228050096851724 + -> g = 92889294 + -> x = 115110207004456909698806038261 + -> y = -19137667681784054624628973533 +GCDE 32052182750761975518649228050096851724 0 + -> g = 32052182750761975518649228050096851724 + -> x = 1 + -> y = 0 +GCDE 32052182750761975518649228050096851724 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 32052182750761975518649228050096851724 7 + -> g = 1 + -> x = 3 + -> y = -13736649750326560936563954878612936453 +GCDE 32052182750761975518649228050096851724 14 + -> g = 2 + -> x = -1 + -> y = 2289441625054426822760659146435489409 +GCDE 32052182750761975518649228050096851724 123 + -> g = 3 + -> x = -4 + -> y = 1042347406528844732313796034149491113 +GCDE 32052182750761975518649228050096851724 1230 + -> g = 6 + -> x = 74 + -> y = -1928342702078362754780522663176558559 +GCDE 32052182750761975518649228050096851724 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -10203432759063496909071922280945854833629276496909075027106202353 + -> y = 2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 4 + -> x = -40813731036253987636287689123783419334517105987636300108424809412 + -> y = 2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 32052182750761975518649228050096851724 -123 + -> g = 3 + -> x = -4 + -> y = -1042347406528844732313796034149491113 +GCDE 32052182750761975518649228050096851724 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -10203432759063496909071922280945854833629276496909075027106202353 + -> y = -2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1839998972523827338782593728961148005767 + -> y = -12910967943414004413956938074429250463 +GCDE 32052182750761975518649228050096851724 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 272877565911469778893036529750941765793334087149670477404511983087875 + -> y = -2926808101621088968857550652617123241 +GCDE 32052182750761975518649228050096851724 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 253778836069059554551347740010931350716760250644753514181097821250371 + -> y = -3459287250911140032199362006422486237 +GCDE 32052182750761975518649228050096851724 5328841272400314897981163497728751426 + -> g = 92889294 + -> x = -19137667681784054624628973533 + -> y = 115110207004456909698806038261 +GCDE 32052182750761975518649228050096851724 32052182750761975518649228050096851724 + -> g = 32052182750761975518649228050096851724 + -> x = 0 + -> y = 1 +GCDE 2 36893488147419103233 + -> g = 1 + -> x = -18446744073709551616 + -> y = 1 +GCDE 2 -36893488147419103233 + -> g = 1 + -> x = -18446744073709551616 + -> y = -1 +GCDE -2 36893488147419103233 + -> g = 1 + -> x = 18446744073709551616 + -> y = 1 +GCDE -2 -36893488147419103233 + -> g = 1 + -> x = 18446744073709551616 + -> y = -1 +GCDE 36893488147419103233 2 + -> g = 1 + -> x = 1 + -> y = -18446744073709551616 +GCDE 36893488147419103233 -2 + -> g = 1 + -> x = 1 + -> y = 18446744073709551616 +GCDE -36893488147419103233 2 + -> g = 1 + -> x = -1 + -> y = -18446744073709551616 +GCDE -36893488147419103233 -2 + -> g = 1 + -> x = -1 + -> y = 18446744073709551616 ===================================== testsuite/tests/lib/integer/integerGcdExt.hs ===================================== @@ -9,10 +9,10 @@ import Control.Monad import GHC.Word import GHC.Base -import qualified GHC.Integer.GMP.Internals as I +import qualified GHC.Num.Integer as I gcdExtInteger :: Integer -> Integer -> (Integer, Integer) -gcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s) +gcdExtInteger a b = case I.integerGcde a b of ( g, s, _t ) -> (g, s) main :: IO () main = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2707c4eae4cf99e6da2709e128f560d91e468357...04bc50b3c8e40387a0d0f090ea23cd68923f1834 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2707c4eae4cf99e6da2709e128f560d91e468357...04bc50b3c8e40387a0d0f090ea23cd68923f1834 You're receiving 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 26 01:15:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:15:20 -0400 Subject: [Git][ghc/ghc][master] Fix typed holes causing linearity errors (#18491) Message-ID: <5f6e962824750_80bb5fbee014696168@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Expr.hs - + testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -198,6 +198,8 @@ tcExpr e@(HsUnboundVar _ occ) res_ty ; name <- newSysName occ ; let ev = mkLocalId name Many ty ; emitNewExprHole occ ev ty + ; tcEmitBindingUsage bottomUE -- Holes fit any usage environment + -- (#18491) ; tcWrapResultO (UnboundOccurrenceOf occ) e (HsUnboundVar ev occ) ty res_ty } ===================================== testsuite/tests/linear/should_compile/LinearHole.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +{-# OPTIONS_GHC -fdefer-typed-holes -Wno-typed-holes #-} + +module LinearHole where -- #18491 + +f :: Int #-> Bool #-> Char +f x y = _1 ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -35,3 +35,4 @@ test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, [''] test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) +test('LinearHole', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a7dae4badcea5b3519005cf4e5fbf15f7e5df59 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a7dae4badcea5b3519005cf4e5fbf15f7e5df59 You're receiving 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 26 01:16:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:16:00 -0400 Subject: [Git][ghc/ghc][master] Various documentation fixes Message-ID: <5f6e96504032c_80b3f84300adf181469943c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - 9 changed files: - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/defer_type_errors.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/safe_haskell.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/typed_holes.rst - docs/users_guide/using-optimisation.rst Changes: ===================================== docs/users_guide/conf.py ===================================== @@ -38,9 +38,6 @@ nitpick_ignore = [ ("extension", "DoAndIfThenElse"), ("extension", "RelaxedPolyRec"), - - # See #16629 - ("extension", "UnliftedFFITypes"), ] rst_prolog = """ @@ -96,13 +93,13 @@ htmlhelp_basename = 'GHCUsersGuide' latex_elements = { 'inputenc': '', 'utf8extra': '', - 'preamble': ''' + 'preamble': r''' \usepackage{fontspec} \usepackage{makeidx} \setsansfont{DejaVu Sans} \setromanfont{DejaVu Serif} \setmonofont{DejaVu Sans Mono} -\setlength{\\tymin}{45pt} +\setlength{\tymin}{45pt} % Avoid a torrent of over-full \hbox warnings \usepackage{microtype} ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -18,7 +18,6 @@ -XAutoDeriveTypeable -XDoAndIfThenElse -XDoRec --XGHCForeignImportPrim -XGenerics -XImplicitPrelude -XJavaScriptFFI ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -800,8 +800,8 @@ displayed. import GHC.Hs.Decls import GHC.Hs.Expr import GHC.Hs.ImpExp - import Avail - import Outputable + import GHC.Types.Avail + import GHC.Utils.Outputable import GHC.Hs.Doc plugin :: Plugin ===================================== docs/users_guide/exts/defer_type_errors.rst ===================================== @@ -115,6 +115,7 @@ In a few cases, even equality constraints cannot be deferred. Specifically: This type signature contains a kind error which cannot be deferred. -- Type equalities under a forall cannot be deferred (c.f. #14605). +- Type equalities under a forall cannot be deferred (c.f. `#14605 + `_). ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -263,8 +263,13 @@ and is not permitted to appear nested within the type, as in the following Primitive imports ~~~~~~~~~~~~~~~~~ -GHC extends the FFI with an additional calling convention ``prim``, -e.g.: :: +.. extension:: GHCForeignImportPrim + :shortdesc: Enable prim calling convention. Intended for internal use only. + + :since: 6.12.1 + +With :extension:`GHCForeignImportPrim`, GHC extends the FFI with an additional +calling convention ``prim``, e.g.: :: foreign import prim "foo" foo :: ByteArray# -> (# Int#, Int# #) ===================================== docs/users_guide/exts/safe_haskell.rst ===================================== @@ -781,7 +781,7 @@ And five warning flags: :shortdesc: warn when an explicitly Safe Haskell module imports a Safe-Inferred one :type: dynamic :reverse: -Wno-inferred-safe-imports - :category: + :category: warnings :since: 8.10.1 @@ -815,7 +815,7 @@ And five warning flags: :shortdesc: warn when the Safe Haskell mode is not explicitly specified. :type: dynamic :reverse: -Wno-missing-safe-haskell-mode - :category: + :category: warnings :since: 8.10.1 ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -109,7 +109,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under plusC = [| $oneC + $twoC |] -- The precise type of a quotation depends on the types of the nested splices inside it:: +- The precise type of a quotation depends on the types of the nested splices inside it:: -- Add a redundant constraint to demonstrate that constraints on the -- monad used to build the representation are propagated when using nested @@ -125,9 +125,8 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under Remember, a top-level splice still requires its argument to be of type ``Q Exp``. So then splicing in ``g`` will cause ``m`` to be instantiated to ``Q``:: - h :: Int - h = $(g) -- m ~ Q - + h :: Int + h = $(g) -- m ~ Q - A *typed* expression splice is written ``$$x``, where ``x`` is is an arbitrary expression. @@ -376,8 +375,6 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under However, there are some GHC-specific extensions which expression quotations currently do not support, including - - Recursive ``do``-statements (see :ghc-ticket:`1262`) - - Type holes in typed splices (see :ghc-ticket:`10945` and :ghc-ticket:`10946`) ===================================== docs/users_guide/exts/typed_holes.rst ===================================== @@ -546,6 +546,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits` :shortdesc: Sort valid hole fits by size. :type: dynamic :reverse: -fno-sort-by-size-hole-fits + :category: verbosity :default: on @@ -557,6 +558,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits` :shortdesc: Sort valid hole fits by subsumption. :type: dynamic :reverse: -fno-sort-by-subsumption-hole-fits + :category: verbosity :default: off ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -361,7 +361,7 @@ by saying ``-fno-wombat``. :default: on Use a special demand transformer for dictionary selectors. - Behaviour is unconditionally enabled starting with 8.14 + Behaviour is unconditionally enabled starting with 9.2 .. ghc-flag:: -fdo-eta-reduction :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83407ffc7acc00cc025b9f6ed063add9ab9f9bcc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83407ffc7acc00cc025b9f6ed063add9ab9f9bcc You're receiving 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 26 01:46:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 25 Sep 2020 21:46:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f6e9d86e6568_80b3f848a372dac147050d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - f856f0c7 by Sebastian Graf at 2020-09-25T21:46:36-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - 0dc83505 by Sebastian Graf at 2020-09-25T21:46:36-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 147f1e6a by Sylvain Henry at 2020-09-25T21:46:39-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Unfold.hs - compiler/GHC/Hs/Extension.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/HsToCore/Pmc/Types.hs - + compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41baa79bec32156c81a707c5f0aebae862af6d18...147f1e6a503304a367de1dc9ed68d6ab6556c943 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/41baa79bec32156c81a707c5f0aebae862af6d18...147f1e6a503304a367de1dc9ed68d6ab6556c943 You're receiving 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 26 01:53:19 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 25 Sep 2020 21:53:19 -0400 Subject: [Git][ghc/ghc][wip/infer-mult-more] 15 commits: Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f6e9f0fae79f_80b3f848707d230147056bd@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/infer-mult-more at Glasgow Haskell Compiler / GHC Commits: 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - de71b9b0 by Krzysztof Gogolewski at 2020-09-26T03:52:00+02:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Unfold.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/defer_type_errors.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/safe_haskell.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/typed_holes.rst - docs/users_guide/using-optimisation.rst - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/846057d1d750eafa5b84a1cdbb7d5234a7627345...de71b9b04a08b7f197a3da42dde4e370c4cc2497 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/846057d1d750eafa5b84a1cdbb7d5234a7627345...de71b9b04a08b7f197a3da42dde4e370c4cc2497 You're receiving 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 26 02:07:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 25 Sep 2020 22:07:32 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Cabal, hsc2hs, directory, process submodules Message-ID: <5f6ea264eeb2e_80b3f8487b72b401470628d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 6c9e9aa7 by Ben Gamari at 2020-09-25T22:07:23-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - 7 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -76,7 +76,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 5f5d63b7dd64b0ec6dbd3bf169defe551ca6a4e6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c9e9aa75b0dc7470e04cd0912c230136b977815 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c9e9aa75b0dc7470e04cd0912c230136b977815 You're receiving 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 26 05:17:07 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 26 Sep 2020 01:17:07 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f6eced319dcb_80b3f8468cf0be41470841@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 Sat Sep 26 05:17:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 26 Sep 2020 01:17:13 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 5 commits: Deprecate Data.Semigroup.Option Message-ID: <5f6eced913966_80b3f83f69f4a5c147086ad@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: b1c4116d by Simon Jakobi at 2020-09-24T13:09:09-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. (cherry picked from commit a90d13091ff82e954432bedd0bb20845c666eddb) - - - - - 29fc00bc by Wander Hillen at 2020-09-24T13:11:02-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. (cherry picked from commit e195dae6d959e2a9b1a22a2ca78db5955e1d7dea) - - - - - 7f418acf by Ryan Scott at 2020-09-24T13:14:46-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. (cherry picked from commit 3ea8ac774efd9ee25156f444eacf49893d48a6c9) - - - - - 4c37274a by Ben Gamari at 2020-09-25T17:39:53-04:00 Bump Cabal, haskeline, directory, process submodules To accomodate Win32 2.10.0.0. - - - - - 12957a0b by Ben Gamari at 2020-09-25T17:39:53-04:00 Disable -Wdeprecations for deepseq Use to use of Data.Semigroup.Option for NFData instance. - - - - - 30 changed files: - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Misc.hs - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/base/Data/List.hs - libraries/base/Data/Semigroup.hs - libraries/base/changelog.md - libraries/directory - libraries/haskeline - libraries/process - mk/warnings.mk - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/T15323.stderr Changes: ===================================== compiler/GHC/Builtin/Utils.hs ===================================== @@ -71,7 +71,7 @@ import GHC.Driver.Types import GHC.Core.Class import GHC.Core.TyCon import GHC.Types.Unique.FM -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Builtin.Types.Literals ( typeNatTyCons ) import GHC.Hs.Doc @@ -179,7 +179,7 @@ knownKeyNamesOkay all_names | otherwise = Just badNamesStr where - namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n) + namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) Utils.singleton m n n) emptyUFM all_names badNamesEnv = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv badNamesPairs = nonDetUFMToList badNamesEnv ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -65,7 +65,7 @@ import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.Bag -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import Data.List import Data.Ord import Control.Monad ( guard ) @@ -356,7 +356,7 @@ unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2 extendRuleBase :: RuleBase -> CoreRule -> RuleBase extendRuleBase rule_base rule - = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule + = extendNameEnv_Acc (:) Utils.singleton rule_base (ruleIdName rule) rule pprRuleBase :: RuleBase -> SDoc pprRuleBase rules = pprUFM rules $ \rss -> ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -71,7 +71,7 @@ module GHC.Hs.Decls ( ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..), CImportSpec(..), -- ** Data-constructor declarations - ConDecl(..), LConDecl, ConDeclGADTPrefixPs(..), + ConDecl(..), LConDecl, HsConDeclDetails, hsConDeclArgTys, hsConDeclTheta, getConNames, getConArgs, -- ** Document comments @@ -111,7 +111,6 @@ import GHC.Core.Coercion import GHC.Types.ForeignCall import GHC.Hs.Extension import GHC.Types.Name -import GHC.Types.Name.Reader import GHC.Types.Name.Set -- others: @@ -1435,12 +1434,13 @@ data ConDecl pass { con_g_ext :: XConDeclGADT pass , con_names :: [Located (IdP pass)] - -- The next four fields describe the type after the '::' + -- The following fields describe the type after the '::' -- See Note [GADT abstract syntax] - -- The following field is Located to anchor API Annotations, - -- AnnForall and AnnDot. - , con_forall :: Located Bool -- ^ True <=> explicit forall + , con_forall :: Located Bool -- ^ True <=> explicit forall -- False => hsq_explicit is empty + -- + -- The 'XRec' is used to anchor API + -- annotations, AnnForall and AnnDot. , con_qvars :: [LHsTyVarBndr Specificity pass] -- Whether or not there is an /explicit/ forall, we still -- need to capture the implicitly-bound type/kind variables @@ -1477,25 +1477,18 @@ type instance XConDeclGADT GhcTc = NoExtField type instance XConDeclH98 (GhcPass _) = NoExtField -type instance XXConDecl GhcPs = ConDeclGADTPrefixPs -type instance XXConDecl GhcRn = NoExtCon -type instance XXConDecl GhcTc = NoExtCon - --- | Stores the types of prefix GADT constructors in the parser. This is used --- in lieu of ConDeclGADT, which requires knowing the specific argument and --- result types, as this is difficult to determine in general in the parser. --- See @Note [GADT abstract syntax]@. -data ConDeclGADTPrefixPs = ConDeclGADTPrefixPs - { con_gp_names :: [Located RdrName] - -- ^ The GADT constructor declaration's names. - , con_gp_ty :: LHsSigType GhcPs - -- ^ The type after the @::@. - , con_gp_doc :: Maybe LHsDocString - -- ^ A possible Haddock comment. - } +type instance XXConDecl (GhcPass _) = NoExtCon {- Note [GADT abstract syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The types of both forms of GADT constructors are very structured, as they +must consist of the quantified type variables (if provided), followed by the +context (if provided), followed by the argument types (if provided), followed +by the result type. (See "Wrinkle: No nested foralls or contexts" below for +more discussion on the restrictions imposed here.) As a result, instead of +storing the type of a GADT constructor as a single LHsType, we split it up +into its constituent components for easier access. + There are two broad ways to classify GADT constructors: * Record-syntax constructors. For example: @@ -1508,48 +1501,45 @@ There are two broad ways to classify GADT constructors: data T a where K :: forall a. Ord a => [a] -> ... -> T a -Initially, both forms of GADT constructors are initially parsed as a single -LHsType. However, GADTs have a certain structure, requiring distinct argument -and result types, as well as imposing restrictions on where `forall`s and -contexts can be (see "Wrinkle: No nested foralls or contexts" below). As a -result, it is convenient to split up the LHsType into its individual -components, which are stored in the ConDeclGADT constructor of ConDecl. - -Where should this splitting occur? For GADT constructors with record syntax, -we split in the parser (in GHC.Parser.PostProcess.mkGadtDecl). We must do this -splitting before the renamer, as we need the record field names for use in -GHC.Hs.Utils.hsConDeclsBinders. +This distinction is recorded in the `con_args :: HsConDetails pass`, which +tracks if we're dealing with a RecCon or PrefixCon. It is easy to distinguish +the two in the AST since record GADT constructors use HsRecTy. This distinction +is made in GHC.Parser.PostProcess.mkGadtDecl. -For prefix GADT constructors, however, the situation is more complicated. It -can be difficult to split a prefix GADT type until we know type operator -fixities. Consider this, for example: +It is worth elaborating a bit more on the process of splitting the argument +types of a GADT constructor, since there are some non-obvious details involved. +While splitting the argument types of a record GADT constructor is easy (they +are stored in an HsRecTy), splitting the arguments of a prefix GADT constructor +is trickier. The basic idea is that we must split along the outermost function +arrows ((->) and (#->)) in the type, which GHC.Hs.Type.splitHsFunType +accomplishes. But what about type operators? Consider: C :: a :*: b -> a :*: b -> a :+: b -Initially, the type of C will parse as: +This could parse in many different ways depending on the precedences of each +type operator. In particular, if (:*:) were to have lower precedence than (->), +then it could very well parse like this: - a :*: (b -> (a :*: (b -> (a :+: b)))) + a :*: ((b -> a) :*: ((b -> a) :+: b))) -So it's hard to split up the arguments until we've done the precedence -resolution (in the renamer). (Unlike prefix GADT types, record GADT types -do not have this problem because of their uniform syntax.) +This would give the false impression that the whole type is part of one large +return type, with no arguments. Note that we do not fully resolve the exact +precedences of each user-defined type operator until the renamer, so this a +more difficult task for the parser. -As a result, we deliberately avoid splitting prefix GADT types in the parser. -Instead, we store the entire LHsType in ConDeclGADTPrefixPs, a GHC-specific -extension constructor to ConDecl. Later, in the renamer -(in GHC.Rename.Module.rnConDecl), we resolve the fixities of all type operators -in the LHsType, which facilitates splitting it into argument and result types -accurately. We finish renaming a ConDeclGADTPrefixPs by putting the split -components into a ConDeclGADT. This is why ConDeclGADTPrefixPs has the suffix --Ps, as it is only used by the parser. +Fortunately, there is no risk of the above happening. GHC's parser gives +special treatment to function arrows, and as a result, they are always parsed +with a lower precedence than any other type operator. As a result, the type +above is actually parsed like this: -Note that the existence of ConDeclGADTPrefixPs does not imply that ConDeclGADT -goes completely unused by the parser. Other consumers of GHC's abstract syntax -are still free to use ConDeclGADT. Indeed, both Haddock and Template Haskell -construct values of type `ConDecl GhcPs` by way of ConDeclGADT, as neither of -them have the same difficulties with operator precedence that GHC's parser -does. As an example, see GHC.ThToHs.cvtConstr, which converts Template Haskell -syntax into GHC syntax. + (a :*: b) -> ((a :*: b) -> (a :+: b)) + +While we won't know the exact precedences of (:*:) and (:+:) until the renamer, +all we are concerned about in the parser is identifying the overall shape of +the argument and result types, which we can accomplish by piggybacking on the +special treatment given to function arrows. In a future where function arrows +aren't given special status in the parser, we will likely have to modify +GHC.Parser.PostProcess.mergeOps to preserve this trick. ----- -- Wrinkle: No nested foralls or contexts @@ -1679,14 +1669,6 @@ pp_condecls cs [] -> False (L _ ConDeclH98{} : _) -> False (L _ ConDeclGADT{} : _) -> True - (L _ (XConDecl x) : _) -> - case ghcPass @p of - GhcPs | ConDeclGADTPrefixPs{} <- x - -> True -#if __GLASGOW_HASKELL__ < 811 - GhcRn -> noExtCon x - GhcTc -> noExtCon x -#endif instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where ppr = pprConDecl @@ -1728,16 +1710,6 @@ pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as) ppr_arrow_chain [] = empty -pprConDecl (XConDecl x) = - case ghcPass @p of - GhcPs | ConDeclGADTPrefixPs { con_gp_names = cons, con_gp_ty = ty - , con_gp_doc = doc } <- x - -> ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> ppr ty -#if __GLASGOW_HASKELL__ < 811 - GhcRn -> noExtCon x - GhcTc -> noExtCon x -#endif - ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -166,8 +166,6 @@ deriving instance Data (ConDecl GhcPs) deriving instance Data (ConDecl GhcRn) deriving instance Data (ConDecl GhcTc) -deriving instance Data ConDeclGADTPrefixPs - -- deriving instance DataIdLR p p => Data (TyFamInstDecl p) deriving instance Data (TyFamInstDecl GhcPs) deriving instance Data (TyFamInstDecl GhcRn) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -68,7 +68,7 @@ module GHC.Hs.Type ( splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe, splitLHsPatSynTy, splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy, - splitLHsSigmaTyInvis, splitLHsGADTPrefixTy, + splitLHsSigmaTyInvis, splitLHsGadtTy, splitHsFunType, hsTyGetAppHead_maybe, mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy, ignoreParens, hsSigType, hsSigWcType, hsPatSigType, @@ -1331,7 +1331,9 @@ mkHsAppKindTy ext ty k -- splitHsFunType decomposes a type (t1 -> t2 ... -> tn) -- Breaks up any parens in the result type: -- splitHsFunType (a -> (b -> c)) = ([a,b], c) -splitHsFunType :: LHsType GhcRn -> ([HsScaled GhcRn (LHsType GhcRn)], LHsType GhcRn) +splitHsFunType :: + LHsType (GhcPass p) + -> ([HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p)) splitHsFunType (L _ (HsParTy _ ty)) = splitHsFunType ty @@ -1460,7 +1462,7 @@ splitLHsSigmaTyInvis_KP ty , (mb_ctxt, ty2) <- splitLHsQualTy_KP ty1 = (mb_tvbs, mb_ctxt, ty2) --- | Decompose a prefix GADT type into its constituent parts. +-- | Decompose a GADT type into its constituent parts. -- Returns @(mb_tvbs, mb_ctxt, body)@, where: -- -- * @mb_tvbs@ are @Just@ the leading @forall at s, if they are provided. @@ -1474,10 +1476,10 @@ 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. -splitLHsGADTPrefixTy :: +splitLHsGadtTy :: LHsType pass -> (Maybe [LHsTyVarBndr Specificity pass], Maybe (LHsContext pass), LHsType pass) -splitLHsGADTPrefixTy = splitLHsSigmaTyInvis_KP +splitLHsGadtTy = splitLHsSigmaTyInvis_KP -- | Decompose a type of the form @forall . body@ into its constituent -- parts. Only splits type variable binders that ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1267,16 +1267,6 @@ hsConDeclsBinders cons (remSeen', flds) = get_flds remSeen args (ns, fs) = go remSeen' rs - XConDecl x -> case ghcPass @p of - GhcPs | ConDeclGADTPrefixPs { con_gp_names = names } <- x - -> (map (L loc . unLoc) names ++ ns, fs) -#if __GLASGOW_HASKELL__ < 811 - GhcRn -> noExtCon x - GhcTc -> noExtCon x -#endif - where - (ns, fs) = go remSeen rs - get_flds :: Seen p -> HsConDeclDetails (GhcPass p) -> (Seen p, [LFieldOcc (GhcPass p)]) get_flds remSeen (RecCon flds) ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Data.Graph.Directed import GHC.Types.SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Types.Unique -import GHC.Utils.Misc hiding ( eqListBy ) +import GHC.Utils.Misc as Utils hiding ( eqListBy ) import GHC.Data.Maybe import GHC.Utils.Binary import GHC.Utils.Fingerprint @@ -1332,7 +1332,7 @@ mkOrphMap get_key decls where go (non_orphs, orphs) d | NotOrphan occ <- get_key d - = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs) + = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) | otherwise = (non_orphs, d:orphs) -- ----------------------------------------------------------------------------- ===================================== compiler/GHC/Parser.y ===================================== @@ -2173,8 +2173,9 @@ gadt_constr :: { LConDecl GhcPs } -- see Note [Difference in parsing GADT and data constructors] -- Returns a list because of: C,D :: ty : optSemi con_list '::' sigtype - {% ams (sLL $2 $> (mkGadtDecl (unLoc $2) $4)) - [mu AnnDcolon $3] } + {% do { decl <- mkGadtDecl (unLoc $2) $4 + ; ams (sLL $2 $> decl) + [mu AnnDcolon $3] } } {- Note [Difference in parsing GADT and data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -688,34 +688,41 @@ mkConDeclH98 name mb_forall mb_cxt args , con_doc = Nothing } -- | Construct a GADT-style data constructor from the constructor names and --- their type. This will return different AST forms for record syntax --- constructors and prefix constructors, as the latter must be handled --- specially in the renamer. See @Note [GADT abstract syntax]@ in --- "GHC.Hs.Decls" for the full story. +-- their type. Some interesting aspects of this function: +-- +-- * This splits up the constructor type into its quantified type variables (if +-- provided), context (if provided), argument types, and result type, and +-- records whether this is a prefix or record GADT constructor. See +-- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details. +-- +-- * If -XLinearTypes is not enabled, the function arrows in a prefix GADT +-- constructor are always interpreted as linear. If -XLinearTypes is enabled, +-- we faithfully record whether -> or #-> was used. mkGadtDecl :: [Located RdrName] -> LHsType GhcPs - -> ConDecl GhcPs -mkGadtDecl names ty - | Just (mtvs, mcxt, args, res_ty) <- mb_record_gadt ty - = ConDeclGADT { con_g_ext = noExtField - , con_names = names - , con_forall = L (getLoc ty) $ isJust mtvs - , con_qvars = fromMaybe [] mtvs - , con_mb_cxt = mcxt - , con_args = args - , con_res_ty = res_ty - , con_doc = Nothing } - | otherwise - = XConDecl $ ConDeclGADTPrefixPs { con_gp_names = names - , con_gp_ty = mkLHsSigType ty - , con_gp_doc = Nothing } + -> P (ConDecl GhcPs) +mkGadtDecl names ty = do + linearEnabled <- getBit LinearTypesBit + + let (args, res_ty) + | L _ (HsFunTy _ _w (L loc (HsRecTy _ rf)) res_ty) <- body_ty + = (RecCon (L loc rf), res_ty) + | otherwise + = let (arg_types, res_type) = splitHsFunType body_ty + arg_types' | linearEnabled = arg_types + | otherwise = map (hsLinear . hsScaledThing) arg_types + in (PrefixCon arg_types', res_type) + + pure $ ConDeclGADT { con_g_ext = noExtField + , con_names = names + , con_forall = L (getLoc ty) $ isJust mtvs + , con_qvars = fromMaybe [] mtvs + , con_mb_cxt = mcxt + , con_args = args + , con_res_ty = res_ty + , con_doc = Nothing } where - mb_record_gadt ty - | (mtvs, mcxt, body_ty) <- splitLHsGADTPrefixTy ty - , L _ (HsFunTy _ _w (L loc (HsRecTy _ rf)) res_ty) <- body_ty - = Just (mtvs, mcxt, RecCon (L loc rf), res_ty) - | otherwise - = Nothing + (mtvs, mcxt, body_ty) = splitLHsGadtTy ty setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -714,15 +714,6 @@ instance HasHaddock (LConDecl GhcPs) where ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_doc = con_doc', con_args = RecCon (L l_rec flds') } - XConDecl (ConDeclGADTPrefixPs { con_gp_names, con_gp_ty }) -> do - -- discardHasInnerDocs is ok because we don't need this info for GADTs. - con_gp_doc' <- discardHasInnerDocs $ getConDoc (getLoc (head con_gp_names)) - con_gp_ty' <- addHaddock con_gp_ty - pure $ L l_con_decl $ - XConDecl (ConDeclGADTPrefixPs - { con_gp_names, - con_gp_ty = con_gp_ty', - con_gp_doc = con_gp_doc' }) -- Keep track of documentation comments on the data constructor or any of its -- fields. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1856,7 +1856,6 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType where h98_style = case condecls of -- Note [Stupid theta] (L _ (ConDeclGADT {})) : _ -> False - (L _ (XConDecl (ConDeclGADTPrefixPs {}))) : _ -> False _ -> True rn_derivs (L loc ds) @@ -2245,6 +2244,12 @@ rnConDecl decl@(ConDeclGADT { con_names = names ; (new_args, fvs2) <- rnConDeclDetails (unLoc (head new_names)) ctxt args ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty + -- Ensure that there are no nested `forall`s or contexts, per + -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts) + -- in GHC.Hs.Type. + ; addNoNestedForallsContextsErr ctxt + (text "GADT constructor type signature") new_res_ty + ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3 ; traceRn "rnConDecl (ConDeclGADT)" @@ -2255,47 +2260,6 @@ rnConDecl decl@(ConDeclGADT { con_names = names , con_doc = mb_doc' }, all_fvs) } } --- This case is only used for prefix GADT constructors generated by GHC's --- parser, where we do not know the argument types until type operator --- precedence has been resolved. See Note [GADT abstract syntax] in --- GHC.Hs.Decls for the full story. -rnConDecl (XConDecl (ConDeclGADTPrefixPs { con_gp_names = names, con_gp_ty = ty - , con_gp_doc = mb_doc })) - = do { mapM_ (addLocM checkConName) names - ; new_names <- mapM lookupLocatedTopBndrRn names - ; mb_doc' <- rnMbLHsDoc mb_doc - - ; let ctxt = ConDeclCtx new_names - ; (ty', fvs) <- rnHsSigType ctxt TypeLevel ty - ; linearTypes <- xopt LangExt.LinearTypes <$> getDynFlags - - -- Now that operator precedence has been resolved, we can split the - -- GADT type into its individual components below. - ; let HsIB { hsib_ext = implicit_tkvs, hsib_body = body } = ty' - (mb_explicit_tkvs, mb_cxt, tau) = splitLHsGADTPrefixTy body - lhas_forall = L (getLoc body) $ isJust mb_explicit_tkvs - explicit_tkvs = fromMaybe [] mb_explicit_tkvs - (arg_tys, res_ty) = splitHsFunType tau - arg_details | linearTypes = PrefixCon arg_tys - | otherwise = PrefixCon $ map (hsLinear . hsScaledThing) arg_tys - - -- NB: The only possibility here is PrefixCon. RecCon is handled - -- separately, through ConDeclGADT, from the parser onwards. - - -- Ensure that there are no nested `forall`s or contexts, per - -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts) - -- in GHC.Hs.Type. - ; addNoNestedForallsContextsErr ctxt - (text "GADT constructor type signature") res_ty - - ; traceRn "rnConDecl (ConDeclGADTPrefixPs)" - (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs) - ; pure (ConDeclGADT { con_g_ext = implicit_tkvs, con_names = new_names - , con_forall = lhas_forall, con_qvars = explicit_tkvs - , con_mb_cxt = mb_cxt, con_args = arg_details - , con_res_ty = res_ty, con_doc = mb_doc' }, - fvs) } - rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs) -> RnM (Maybe (LHsContext GhcRn), FreeVars) rnMbContext _ Nothing = return (Nothing, emptyFVs) ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -57,7 +57,7 @@ import GHC.Utils.Outputable as Outputable import GHC.Data.Maybe import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Basic ( TopLevelFlag(..), StringLiteral(..) ) -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Data.FastString import GHC.Data.FastString.Env import GHC.Types.Id @@ -1180,8 +1180,8 @@ mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt] mkChildEnv gres = foldr add emptyNameEnv gres where add gre env = case gre_par gre of - FldParent p _ -> extendNameEnv_Acc (:) singleton env p gre - ParentIs p -> extendNameEnv_Acc (:) singleton env p gre + FldParent p _ -> extendNameEnv_Acc (:) Utils.singleton env p gre + ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre NoParent -> env findChildren :: NameEnv [a] -> Name -> [a] ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Types.SrcLoc -import GHC.Utils.Misc( singleton ) +import GHC.Utils.Misc as Utils ( singleton ) import GHC.Data.Maybe( orElse ) import Data.Maybe( mapMaybe ) import Control.Monad( unless ) @@ -551,7 +551,7 @@ lookupPragEnv :: TcPragEnv -> Name -> [LSig GhcRn] lookupPragEnv prag_fn n = lookupNameEnv prag_fn n `orElse` [] extendPragEnv :: TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv -extendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) singleton prag_fn n sig +extendPragEnv prag_fn (n, sig) = extendNameEnv_Acc (:) Utils.singleton prag_fn n sig --------------- mkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -611,14 +611,6 @@ cvtConstr (ForallC tvs ctxt con) where all_tvs = tvs' ++ ex_tvs - -- The GadtC and RecGadtC cases of cvtConstr will always return a - -- ConDeclGADT, not a ConDeclGADTPrefixPs, so this case is unreachable. - -- See Note [GADT abstract syntax] in GHC.Hs.Decls for more on the - -- distinction between ConDeclGADT and ConDeclGADTPrefixPs. - add_forall _ _ con@(XConDecl (ConDeclGADTPrefixPs {})) = - pprPanic "cvtConstr.add_forall: Unexpected ConDeclGADTPrefixPs" - (Outputable.ppr con) - cvtConstr (GadtC [] _strtys _ty) = failWith (text "GadtC must have at least one constructor name") ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -84,7 +84,7 @@ import GHC.Utils.Outputable import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set -import GHC.Utils.Misc +import GHC.Utils.Misc as Utils import GHC.Types.Name.Env import Data.Data @@ -959,7 +959,7 @@ mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv mkGlobalRdrEnv gres = foldr add emptyGlobalRdrEnv gres where - add gre env = extendOccEnv_Acc insertGRE singleton env + add gre env = extendOccEnv_Acc insertGRE Utils.singleton env (greOccName gre) gre @@ -993,7 +993,7 @@ transformGREs trans_gre occs rdr_env extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv extendGlobalRdrEnv env gre - = extendOccEnv_Acc insertGRE singleton env + = extendOccEnv_Acc insertGRE Utils.singleton env (greOccName gre) gre shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Utils.Misc ( listLengthCmp, atLength, equalLength, compareLength, leLength, ltLength, - isSingleton, only, singleton, + isSingleton, only, GHC.Utils.Misc.singleton, notNull, snocView, isIn, isn'tIn, ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -31,6 +31,7 @@ ghcWarningsArgs = do , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] , package compiler ? pure [ "-Wcpp-undef" ] , package directory ? pure [ "-Wno-unused-imports" ] + , package deepseq ? pure [ "-Wno-deprecations" ] , package ghc ? pure [ "-Wcpp-undef" , "-Wincomplete-uni-patterns" , "-Wincomplete-record-updates" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/base/Data/List.hs ===================================== @@ -25,6 +25,7 @@ module Data.List , tail , init , uncons + , singleton , null , length ===================================== libraries/base/Data/Semigroup.hs ===================================== @@ -350,8 +350,6 @@ instance Bifoldable Arg where instance Bitraversable Arg where bitraverse f g (Arg a b) = Arg <$> f a <*> g b --- | Use @'Option' ('First' a)@ to get the behavior of --- 'Data.Monoid.First' from "Data.Monoid". newtype First a = First { getFirst :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0 @@ -408,8 +406,6 @@ instance Monad First where instance MonadFix First where mfix f = fix (f . getFirst) --- | Use @'Option' ('Last' a)@ to get the behavior of --- 'Data.Monoid.Last' from "Data.Monoid" newtype Last a = Last { getLast :: a } deriving ( Bounded -- ^ @since 4.9.0.0 , Eq -- ^ @since 4.9.0.0 @@ -514,6 +510,8 @@ mtimesDefault n x | n == 0 = mempty | otherwise = unwrapMonoid (stimes n (WrapMonoid x)) +{-# DEPRECATED Option, option "will be removed in GHC 9.2; use 'Maybe' instead." #-} + -- | 'Option' is effectively 'Maybe' with a better instance of -- 'Monoid', built off of an underlying 'Semigroup' instead of an -- underlying 'Monoid'. @@ -523,8 +521,7 @@ mtimesDefault n x -- -- In GHC 8.4 and higher, the 'Monoid' instance for 'Maybe' has been -- corrected to lift a 'Semigroup' instance instead of a 'Monoid' --- instance. Consequently, this type is no longer useful. It will be --- marked deprecated in GHC 8.8 and removed in GHC 8.10. +-- instance. Consequently, this type is no longer useful. newtype Option a = Option { getOption :: Maybe a } deriving ( Eq -- ^ @since 4.9.0.0 , Ord -- ^ @since 4.9.0.0 ===================================== libraries/base/changelog.md ===================================== @@ -14,6 +14,9 @@ * The planned deprecation of `Data.Monoid.First` and `Data.Monoid.Last` is scrapped due to difficulties with the suggested migration path. + * `Data.Semigroup.Option` and the accompanying `option` function are + deprecated and scheduled for removal in 4.16. + * Add `Generic` instances to `Fingerprint`, `GiveGCStats`, `GCFlags`, `ConcFlags`, `DebugFlags`, `CCFlags`, `DoHeapProfile`, `ProfFlags`, `DoTrace`, `TraceFlags`, `TickyFlags`, `ParFlags`, `RTSFlags`, `RTSStats`, ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 5f16b76168f13c6413413386efc44fb1152048d5 +Subproject commit 2790f1c6ed94990ed51466079e8fb1097129c9b8 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit cb1d1a6ead68f0e1b209277e79ec608980e9ac84 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== mk/warnings.mk ===================================== @@ -80,6 +80,8 @@ libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints libraries/haskeline_dist-install_EXTRA_HC_OPTS += -Wno-simplifiable-class-constraints +# temporarily turn off deprecations in deepseq due to NFData Option instance. +libraries/deepseq_dist-install_EXTRA_HC_OPTS += -Wno-deprecations # temporarily turn off unused-imports warnings for pretty libraries/pretty_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr ===================================== @@ -372,31 +372,35 @@ (Nothing) (Nothing) [({ T17544.hs:25:5-18 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:25:5-8 } - (Unqual - {OccName: MkD5}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:25:5-8 } + (Unqual + {OccName: MkD5}))] + ({ T17544.hs:25:13-18 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:25:13-18 } + (HsAppTy (NoExtField) - ({ T17544.hs:25:13-18 } - (HsAppTy + ({ T17544.hs:25:13-14 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:25:13-14 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:25:13-14 } - (Unqual - {OccName: D5})))) + (Unqual + {OccName: D5})))) + ({ T17544.hs:25:16-18 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:25:16-18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:25:16-18 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) @@ -504,31 +508,35 @@ (Nothing) (Nothing) [({ T17544.hs:31:5-18 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:31:5-8 } - (Unqual - {OccName: MkD6}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:31:5-8 } + (Unqual + {OccName: MkD6}))] + ({ T17544.hs:31:13-18 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:31:13-18 } + (HsAppTy (NoExtField) - ({ T17544.hs:31:13-18 } - (HsAppTy + ({ T17544.hs:31:13-14 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:31:13-14 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:31:13-14 } - (Unqual - {OccName: D6})))) + (Unqual + {OccName: D6})))) + ({ T17544.hs:31:16-18 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:31:16-18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:31:16-18 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) @@ -636,31 +644,35 @@ (Nothing) (Nothing) [({ T17544.hs:37:5-18 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:37:5-8 } - (Unqual - {OccName: MkD7}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:37:5-8 } + (Unqual + {OccName: MkD7}))] + ({ T17544.hs:37:13-18 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:37:13-18 } + (HsAppTy (NoExtField) - ({ T17544.hs:37:13-18 } - (HsAppTy + ({ T17544.hs:37:13-14 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:37:13-14 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:37:13-14 } - (Unqual - {OccName: D7})))) + (Unqual + {OccName: D7})))) + ({ T17544.hs:37:16-18 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:37:16-18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:37:16-18 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) @@ -768,31 +780,35 @@ (Nothing) (Nothing) [({ T17544.hs:43:5-18 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:43:5-8 } - (Unqual - {OccName: MkD8}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:43:5-8 } + (Unqual + {OccName: MkD8}))] + ({ T17544.hs:43:13-18 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:43:13-18 } + (HsAppTy (NoExtField) - ({ T17544.hs:43:13-18 } - (HsAppTy + ({ T17544.hs:43:13-14 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:43:13-14 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:43:13-14 } - (Unqual - {OccName: D8})))) + (Unqual + {OccName: D8})))) + ({ T17544.hs:43:16-18 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:43:16-18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:43:16-18 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) @@ -900,31 +916,35 @@ (Nothing) (Nothing) [({ T17544.hs:49:5-18 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:49:5-8 } - (Unqual - {OccName: MkD9}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:49:5-8 } + (Unqual + {OccName: MkD9}))] + ({ T17544.hs:49:13-18 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:49:13-18 } + (HsAppTy (NoExtField) - ({ T17544.hs:49:13-18 } - (HsAppTy + ({ T17544.hs:49:13-14 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:49:13-14 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:49:13-14 } - (Unqual - {OccName: D9})))) + (Unqual + {OccName: D9})))) + ({ T17544.hs:49:16-18 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:49:16-18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:49:16-18 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) @@ -1032,31 +1052,35 @@ (Nothing) (Nothing) [({ T17544.hs:55:5-20 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544.hs:55:5-9 } - (Unqual - {OccName: MkD10}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544.hs:55:5-9 } + (Unqual + {OccName: MkD10}))] + ({ T17544.hs:55:14-20 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544.hs:55:14-20 } + (HsAppTy (NoExtField) - ({ T17544.hs:55:14-20 } - (HsAppTy + ({ T17544.hs:55:14-16 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544.hs:55:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:55:14-16 } - (Unqual - {OccName: D10})))) + (Unqual + {OccName: D10})))) + ({ T17544.hs:55:18-20 } + (HsTyVar + (NoExtField) + (NotPromoted) ({ T17544.hs:55:18-20 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:55:18-20 } - (Unqual - {OccName: Int}))))))) - (Nothing))))] + (Unqual + {OccName: Int})))))) + (Nothing)))] ({ } []))))))] (Nothing))))) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -30,24 +30,28 @@ (Nothing) (Nothing) [({ T17544_kw.hs:16:9-20 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544_kw.hs:16:9-13 } - (Unqual - {OccName: MkFoo}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544_kw.hs:16:9-13 } + (Unqual + {OccName: MkFoo}))] + ({ T17544_kw.hs:16:18-20 } + (False)) + [] + (Nothing) + (PrefixCon + []) + ({ T17544_kw.hs:16:18-20 } + (HsTyVar (NoExtField) + (NotPromoted) ({ T17544_kw.hs:16:18-20 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544_kw.hs:16:18-20 } - (Unqual - {OccName: Foo}))))) - (Just - ({ T17544_kw.hs:15:10-35 } - (HsDocString - " Bad comment for MkFoo"))))))] + (Unqual + {OccName: Foo})))) + (Just + ({ T17544_kw.hs:15:10-35 } + (HsDocString + " Bad comment for MkFoo")))))] ({ } []))))) ,({ T17544_kw.hs:(18,1)-(19,26) } @@ -70,33 +74,34 @@ (Nothing) (Nothing) [({ T17544_kw.hs:19:9-26 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T17544_kw.hs:19:9-13 } - (Unqual - {OccName: MkBar}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T17544_kw.hs:19:9-13 } + (Unqual + {OccName: MkBar}))] + ({ T17544_kw.hs:19:18-26 } + (False)) + [] + (Nothing) + (PrefixCon + [(HsScaled + (HsLinearArrow) + ({ T17544_kw.hs:19:18-19 } + (HsTupleTy + (NoExtField) + (HsBoxedOrConstraintTuple) + [])))]) + ({ T17544_kw.hs:19:24-26 } + (HsTyVar (NoExtField) - ({ T17544_kw.hs:19:18-26 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544_kw.hs:19:18-19 } - (HsTupleTy - (NoExtField) - (HsBoxedOrConstraintTuple) - [])) - ({ T17544_kw.hs:19:24-26 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544_kw.hs:19:24-26 } - (Unqual - {OccName: Bar}))))))) - (Just - ({ T17544_kw.hs:18:13-38 } - (HsDocString - " Bad comment for MkBar"))))))] + (NotPromoted) + ({ T17544_kw.hs:19:24-26 } + (Unqual + {OccName: Bar})))) + (Just + ({ T17544_kw.hs:18:13-38 } + (HsDocString + " Bad comment for MkBar")))))] ({ } []))))) ,({ T17544_kw.hs:(21,1)-(24,18) } ===================================== testsuite/tests/parser/should_compile/T15323.stderr ===================================== @@ -36,67 +36,62 @@ (Nothing) (Nothing) [({ T15323.hs:6:5-54 } - (XConDecl - (ConDeclGADTPrefixPs - [({ T15323.hs:6:5-14 } - (Unqual - {OccName: TestParens}))] - (HsIB + (ConDeclGADT + (NoExtField) + [({ T15323.hs:6:5-14 } + (Unqual + {OccName: TestParens}))] + ({ T15323.hs:6:20-54 } + (True)) + [({ T15323.hs:6:27 } + (UserTyVar + (NoExtField) + (SpecifiedSpec) + ({ T15323.hs:6:27 } + (Unqual + {OccName: v}))))] + (Just + ({ T15323.hs:6:31-36 } + [({ T15323.hs:6:31-36 } + (HsParTy + (NoExtField) + ({ T15323.hs:6:32-35 } + (HsAppTy + (NoExtField) + ({ T15323.hs:6:32-33 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T15323.hs:6:32-33 } + (Unqual + {OccName: Eq})))) + ({ T15323.hs:6:35 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T15323.hs:6:35 } + (Unqual + {OccName: v}))))))))])) + (PrefixCon + []) + ({ T15323.hs:6:41-54 } + (HsAppTy (NoExtField) - ({ T15323.hs:6:20-54 } - (HsForAllTy + ({ T15323.hs:6:41-52 } + (HsTyVar (NoExtField) - (HsForAllInvis - (NoExtField) - [({ T15323.hs:6:27 } - (UserTyVar - (NoExtField) - (SpecifiedSpec) - ({ T15323.hs:6:27 } - (Unqual - {OccName: v}))))]) - ({ T15323.hs:6:31-54 } - (HsQualTy - (NoExtField) - ({ T15323.hs:6:31-36 } - [({ T15323.hs:6:31-36 } - (HsParTy - (NoExtField) - ({ T15323.hs:6:32-35 } - (HsAppTy - (NoExtField) - ({ T15323.hs:6:32-33 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T15323.hs:6:32-33 } - (Unqual - {OccName: Eq})))) - ({ T15323.hs:6:35 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T15323.hs:6:35 } - (Unqual - {OccName: v}))))))))]) - ({ T15323.hs:6:41-54 } - (HsAppTy - (NoExtField) - ({ T15323.hs:6:41-52 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T15323.hs:6:41-52 } - (Unqual - {OccName: MaybeDefault})))) - ({ T15323.hs:6:54 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T15323.hs:6:54 } - (Unqual - {OccName: v}))))))))))) - (Nothing))))] + (NotPromoted) + ({ T15323.hs:6:41-52 } + (Unqual + {OccName: MaybeDefault})))) + ({ T15323.hs:6:54 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T15323.hs:6:54 } + (Unqual + {OccName: v})))))) + (Nothing)))] ({ } [])))))] (Nothing) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd...12957a0b1c74e35f1584b09ba90caa52752be575 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d4d44edbe4f9acbd523b3cc049f9a6ac3f7f0ddd...12957a0b1c74e35f1584b09ba90caa52752be575 You're receiving 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 26 09:26:42 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Sat, 26 Sep 2020 05:26:42 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 4 commits: :broom: Cleanup Message-ID: <5f6f0952f39ad_80b1107c9c814711943@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 2f72882d by Moritz Angermann at 2020-09-23T14:17:11+00:00 :broom: Cleanup - - - - - 0067fa36 by Moritz Angermann at 2020-09-23T14:17:27+00:00 Adds LLVM (AArch64) CI Job - - - - - 87817368 by Moritz Angermann at 2020-09-23T14:17:27+00:00 Add validate as well. - - - - - a378fc67 by Moritz Angermann at 2020-09-25T08:33:30+00:00 Revert "Simplify aarch64 StgRun" This reverts commit f27472c0483db2382344f4a8f4c1b2a192d98725. - - - - - 22 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - + compiler/GHC/CmmToAsm/AArch64.hs - 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/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Instr.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/Driver/Backend.hs - compiler/ghc.cabal.in - docs/users_guide/expected-undocumented-flags.txt - hadrian/src/Oracles/Flag.hs - rts/StgCRun.c Changes: ===================================== .gitlab-ci.yml ===================================== @@ -489,6 +489,20 @@ nightly-aarch64-linux-deb10: variables: TEST_TYPE: slowtest +.build-aarch64-linux-deb10-llvm: + extends: .build-aarch64-linux-deb10 + stage: full-build + variables: + BUILD_FLAVOUR: perf-llvm + tags: + - aarch64-linux + +validate-aarch64-linux-deb10-llvm: + extends: .build-aarch64-linux-deb10-llvm + artifacts: + when: always + expire_in: 2 week + ################################# # armv7-linux-deb10 ################################# ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -131,6 +131,7 @@ import GHC.Utils.Panic import GHC.Data.FastString import GHC.Driver.Session import GHC.Driver.Backend +import GHC.Driver.Ppr import GHC.Platform import GHC.Types.Unique.Set import GHC.Utils.Misc @@ -271,7 +272,7 @@ data CLabel deriving Eq instance Show CLabel where - show = showSDocUnsafe . ppr + show = showPprUnsafe . ppr isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -83,12 +83,7 @@ import GHC.Prelude import qualified GHC.CmmToAsm.X86 as X86 import qualified GHC.CmmToAsm.PPC as PPC import qualified GHC.CmmToAsm.SPARC as SPARC - -import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64.CodeGen -import qualified GHC.CmmToAsm.AArch64.Regs as AArch64.Regs -import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64.RegInfo -import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.Instr -import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64.Ppr +import qualified GHC.CmmToAsm.AArch64 as AArch64 import GHC.CmmToAsm.Reg.Liveness import qualified GHC.CmmToAsm.Reg.Linear as Linear @@ -168,50 +163,13 @@ nativeCodeGen dflags this_mod modLoc h us cmms ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64" ArchS390X -> panic "nativeCodeGen: No NCG for S390X" ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" - ArchAArch64 -> nCG' (aarch64NcgImpl config) + ArchAArch64 -> nCG' (AArch64.ncgAArch64 config) ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" -aarch64NcgImpl :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr.Instr AArch64.RegInfo.JumpDest -aarch64NcgImpl config - = NcgImpl { - ncgConfig = config - ,cmmTopCodeGen = AArch64.CodeGen.cmmTopCodeGen - ,generateJumpTableForInstr = AArch64.CodeGen.generateJumpTableForInstr config - ,getJumpDestBlockId = AArch64.RegInfo.getJumpDestBlockId - ,canShortcut = AArch64.RegInfo.canShortcut - ,shortcutStatics = AArch64.RegInfo.shortcutStatics - ,shortcutJump = AArch64.RegInfo.shortcutJump - ,pprNatCmmDecl = AArch64.Ppr.pprNatCmmDecl config - ,maxSpillSlots = AArch64.Instr.maxSpillSlots config - ,allocatableRegs = AArch64.Regs.allocatableRegs platform - ,ncgAllocMoreStack = AArch64.Instr.allocMoreStack platform - ,ncgExpandTop = id - ,ncgMakeFarBranches = const id - ,extractUnwindPoints = const [] - ,invertCondBranches = \_ _ -> id - } - where - platform = ncgPlatform config --- --- Allocating more stack space for spilling is currently only --- supported for the linear register allocator on x86/x86_64, the rest --- default to the panic below. To support allocating extra stack on --- more platforms provide a definition of ncgAllocMoreStack. --- -noAllocMoreStack :: Int -> NatCmmDecl statics instr - -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]) -noAllocMoreStack amount _ - = panic $ "Register allocator: out of stack slots (need " ++ show amount ++ ")\n" - ++ " If you are trying to compile SHA1.hs from the crypto library then this\n" - ++ " is a known limitation in the linear allocator.\n" - ++ "\n" - ++ " Try enabling the graph colouring allocator with -fregs-graph instead." - ++ " You can still file a bug report if you like.\n" - -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. data NativeGenAcc statics instr ===================================== compiler/GHC/CmmToAsm/AArch64.hs ===================================== @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for x86 and x86-64 architectures +module GHC.CmmToAsm.AArch64 + ( ncgAArch64 ) +where + +import GHC.Prelude + +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Types + +import qualified GHC.CmmToAsm.AArch64.Instr as AArch64 +import qualified GHC.CmmToAsm.AArch64.Ppr as AArch64 +import qualified GHC.CmmToAsm.AArch64.CodeGen as AArch64 +import qualified GHC.CmmToAsm.AArch64.Regs as AArch64 +import qualified GHC.CmmToAsm.AArch64.RegInfo as AArch64 + +ncgAArch64 :: NCGConfig -> NcgImpl RawCmmStatics AArch64.Instr AArch64.JumpDest +ncgAArch64 config + = NcgImpl { + ncgConfig = config + ,cmmTopCodeGen = AArch64.cmmTopCodeGen + ,generateJumpTableForInstr = AArch64.generateJumpTableForInstr config + ,getJumpDestBlockId = AArch64.getJumpDestBlockId + ,canShortcut = AArch64.canShortcut + ,shortcutStatics = AArch64.shortcutStatics + ,shortcutJump = AArch64.shortcutJump + ,pprNatCmmDecl = AArch64.pprNatCmmDecl config + ,maxSpillSlots = AArch64.maxSpillSlots config + ,allocatableRegs = AArch64.allocatableRegs platform + ,ncgAllocMoreStack = AArch64.allocMoreStack platform + ,ncgExpandTop = id + ,ncgMakeFarBranches = const id + ,extractUnwindPoints = const [] + ,invertCondBranches = \_ _ -> id + } + where + platform = ncgPlatform config + +-- | Instruction instance for aarch64 +instance Instruction AArch64.Instr where + regUsageOfInstr = AArch64.regUsageOfInstr + patchRegsOfInstr = AArch64.patchRegsOfInstr + isJumpishInstr = AArch64.isJumpishInstr + jumpDestsOfInstr = AArch64.jumpDestsOfInstr + patchJumpInstr = AArch64.patchJumpInstr + mkSpillInstr = AArch64.mkSpillInstr + mkLoadInstr = AArch64.mkLoadInstr + takeDeltaInstr = AArch64.takeDeltaInstr + isMetaInstr = AArch64.isMetaInstr + mkRegRegMoveInstr _ = AArch64.mkRegRegMoveInstr + takeRegRegMoveInstr = AArch64.takeRegRegMoveInstr + mkJumpInstr = AArch64.mkJumpInstr + mkStackAllocInstr = AArch64.mkStackAllocInstr + mkStackDeallocInstr = AArch64.mkStackDeallocInstr + mkComment = pure . AArch64.COMMENT + pprInstr = AArch64.pprInstr ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -18,30 +18,25 @@ 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 ) -import GHC.CmmToAsm.Instr +-- import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config -import GHC.Platform.Reg.Class +import GHC.CmmToAsm.Types 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,15 +54,13 @@ 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 import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc - -import Debug.Trace +import GHC.Utils.Panic -- @cmmTopCodeGen@ will be our main entry point to code gen. Here we'll get -- @RawCmmDecl@; see GHC.Cmm @@ -113,11 +106,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 +323,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 @@ -345,15 +337,15 @@ isIntFormat = not . isFloatFormat -- ----------------------------------------------------------------------------- -- General things for putting together code sequences --- Expand CmmRegOff. ToDo: should we do it this way around, or convert --- CmmExprs into CmmRegOff? -mangleIndexTree :: Platform -> CmmExpr -> CmmExpr -mangleIndexTree platform (CmmRegOff reg off) - = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType platform reg) +-- -- Expand CmmRegOff. ToDo: should we do it this way around, or convert +-- -- CmmExprs into CmmRegOff? +-- mangleIndexTree :: Platform -> CmmExpr -> CmmExpr +-- mangleIndexTree platform (CmmRegOff reg off) +-- = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] +-- where width = typeWidth (cmmRegType platform reg) -mangleIndexTree _ _ - = panic "AArch64.CodeGen.mangleIndexTree: no match" +-- mangleIndexTree _ _ +-- = panic "AArch64.CodeGen.mangleIndexTree: no match" -- | The dual to getAnyReg: compute an expression into a register, but -- we don't mind which one it is. @@ -879,7 +871,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 +880,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 +969,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 +1224,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/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 ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# language CPP, BangPatterns #-} module GHC.CmmToAsm.AArch64.Instr @@ -11,11 +12,13 @@ import GHC.Prelude import GHC.CmmToAsm.AArch64.Cond import GHC.CmmToAsm.AArch64.Regs -import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Instr (RegUsage(..)) import GHC.CmmToAsm.Format -import GHC.CmmToAsm.Reg.Target +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils +-- 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 +26,20 @@ 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 GHC.Utils.Panic + import Control.Monad (replicateM) import Data.Maybe (fromMaybe) -import Debug.Trace +-- import Debug.Trace import GHC.Stack import Data.Bits ((.&.), complement) @@ -65,24 +70,6 @@ spillSlotToOffset :: NCGConfig -> Int -> Int spillSlotToOffset config slot = stackFrameHeaderSize (ncgPlatform config) + spillSlotSize * slot --- | Instruction instance for powerpc -instance Instruction Instr where - regUsageOfInstr = aarch64_regUsageOfInstr - patchRegsOfInstr = aarch64_patchRegsOfInstr - isJumpishInstr = aarch64_isJumpishInstr - jumpDestsOfInstr = aarch64_jumpDestsOfInstr - patchJumpInstr = aarch64_patchJumpInstr - mkSpillInstr = aarch64_mkSpillInstr - mkLoadInstr = aarch64_mkLoadInstr - takeDeltaInstr = aarch64_takeDeltaInstr - isMetaInstr = aarch64_isMetaInstr - mkRegRegMoveInstr _ = aarch64_mkRegRegMoveInstr - takeRegRegMoveInstr = aarch64_takeRegRegMoveInstr - 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. -- Just state precisely the regs read and written by that insn. @@ -94,12 +81,11 @@ instance Instruction Instr where instance Outputable RegUsage where ppr (RU reads writes) = text "RegUsage(reads:" <+> ppr reads <> comma <+> text "writes:" <+> ppr writes <> char ')' -aarch64_regUsageOfInstr :: Platform -> Instr -> RegUsage -aarch64_regUsageOfInstr platform instr = case instr of - ANN _ i -> aarch64_regUsageOfInstr platform i +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of + ANN _ i -> 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) @@ -115,7 +101,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 +168,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" @@ -218,13 +203,12 @@ callerSavedRegisters -- | Apply a given mapping to all the register references in this -- instruction. -aarch64_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr -aarch64_patchRegsOfInstr instr env = case instr of +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (aarch64_patchRegsOfInstr i env) + ANN d i -> ANN d (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) @@ -280,6 +264,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 "patchRegsOfInstr" (text $ show instr) where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -298,9 +283,9 @@ aarch64_patchRegsOfInstr instr env = case instr of -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -aarch64_isJumpishInstr :: Instr -> Bool -aarch64_isJumpishInstr instr = case instr of - ANN _ i -> aarch64_isJumpishInstr i +isJumpishInstr :: Instr -> Bool +isJumpishInstr instr = case instr of + ANN _ i -> isJumpishInstr i CBZ{} -> True CBNZ{} -> True J{} -> True @@ -312,23 +297,23 @@ aarch64_isJumpishInstr instr = case instr of -- | Checks whether this instruction is a jump/branch instruction. -- One that can change the flow of control in a way that the -- register allocator needs to worry about. -aarch64_jumpDestsOfInstr :: Instr -> [BlockId] -aarch64_jumpDestsOfInstr (ANN _ i) = aarch64_jumpDestsOfInstr i -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 (BCOND _ t) = [ id | TBlock id <- [t]] -aarch64_jumpDestsOfInstr _ = [] +jumpDestsOfInstr :: Instr -> [BlockId] +jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i +jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] +jumpDestsOfInstr _ = [] -- | Change the destination of this jump instruction. -- Used in the linear allocator when adding fixup blocks for join -- points. -aarch64_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr -aarch64_patchJumpInstr instr patchF +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr +patchJumpInstr instr patchF = case instr of - ANN d i -> ANN d (aarch64_patchJumpInstr i patchF) + ANN d i -> ANN d (patchJumpInstr i patchF) CBZ r (TBlock bid) -> CBZ r (TBlock (patchF bid)) CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid)) J (TBlock bid) -> J (TBlock (patchF bid)) @@ -354,7 +339,7 @@ aarch64_patchJumpInstr instr patchF -- 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 +mkSpillInstr :: HasCallStack => NCGConfig -> Reg -- register to spill @@ -362,14 +347,14 @@ aarch64_mkSpillInstr -> Int -- spill slot to use -> [Instr] -aarch64_mkSpillInstr config reg delta slot = +mkSpillInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of 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) + imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -382,21 +367,21 @@ aarch64_mkSpillInstr config reg delta slot = off = spillSlotToOffset config slot -aarch64_mkLoadInstr +mkLoadInstr :: NCGConfig -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use -> [Instr] -aarch64_mkLoadInstr config reg delta slot = +mkLoadInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of 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) + imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -412,16 +397,16 @@ aarch64_mkLoadInstr config reg delta slot = -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta -aarch64_takeDeltaInstr :: Instr -> Maybe Int -aarch64_takeDeltaInstr (ANN _ i) = aarch64_takeDeltaInstr i -aarch64_takeDeltaInstr (DELTA i) = Just i -aarch64_takeDeltaInstr _ = Nothing +takeDeltaInstr :: Instr -> Maybe Int +takeDeltaInstr (ANN _ i) = takeDeltaInstr i +takeDeltaInstr (DELTA i) = Just i +takeDeltaInstr _ = Nothing -- Not real instructions. Just meta data -aarch64_isMetaInstr :: Instr -> Bool -aarch64_isMetaInstr instr +isMetaInstr :: Instr -> Bool +isMetaInstr instr = case instr of - ANN _ i -> aarch64_isMetaInstr i + ANN _ i -> isMetaInstr i COMMENT{} -> True MULTILINE_COMMENT{} -> True LOCATION{} -> True @@ -434,32 +419,32 @@ 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 = ANN (text $ "Reg->Reg Move: " ++ show src ++ " -> " ++ show dst) $ MOV (OpReg W64 dst) (OpReg W64 src) +mkRegRegMoveInstr :: Reg -> Reg -> Instr +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) ---aarch64_takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst) -aarch64_takeRegRegMoveInstr _ = Nothing +takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) +--takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst) +takeRegRegMoveInstr _ = Nothing -- | Make an unconditional jump instruction. -aarch64_mkJumpInstr :: BlockId -> [Instr] -aarch64_mkJumpInstr id = [B (TBlock id)] +mkJumpInstr :: BlockId -> [Instr] +mkJumpInstr id = [B (TBlock id)] -aarch64_mkStackAllocInstr :: Platform -> Int -> [Instr] -aarch64_mkStackAllocInstr platform n +mkStackAllocInstr :: Platform -> Int -> [Instr] +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) + | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : mkStackAllocInstr platform (n - 4095) +mkStackAllocInstr _platform n = pprPanic "mkStackAllocInstr" (int n) -aarch64_mkStackDeallocInstr :: Platform -> Int -> [Instr] -aarch64_mkStackDeallocInstr platform n +mkStackDeallocInstr :: Platform -> Int -> [Instr] +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) + | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : mkStackDeallocInstr platform (n - 4095) +mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n) -- -- See note [extra spill slots] in X86/Instr.hs @@ -500,8 +485,8 @@ 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 | jumpDestsOfInstr insn /= [] + -> patchJumpInstr insn retarget : r _other -> insn : r where retarget b = fromMaybe b (mapLookup b new_blockmap) @@ -555,7 +540,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 @@ -643,7 +628,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" @@ -684,7 +669,7 @@ 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)) @@ -773,9 +758,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/Ppr.hs ===================================== @@ -1,19 +1,23 @@ -module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl) where +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where import GHC.Prelude hiding (EQ) -import Data.List (findIndex, all) +import Data.Word +import qualified Data.Array.Unsafe as U ( castSTUArray ) +import Data.Array.ST +import Control.Monad.ST import GHC.CmmToAsm.AArch64.Instr import GHC.CmmToAsm.AArch64.Regs import GHC.CmmToAsm.AArch64.Cond 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.CmmToAsm.Types +import GHC.CmmToAsm.Utils import GHC.Cmm hiding (topInfoTable) import GHC.Cmm.Dataflow.Collections @@ -30,6 +34,8 @@ import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Driver.Session (targetPlatform) +import GHC.Utils.Panic + pprProcAlignment :: NCGConfig -> SDoc pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config) where @@ -50,7 +56,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = -- pprProcAlignment config $$ pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock config top_info) blocks) $$ - (if ncgDebugLevel config > 0 + (if ncgDwarfEnabled config then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl platform lbl @@ -72,8 +78,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 +85,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. @@ -121,7 +125,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) = maybe_infotable $ pprLabel platform asmLbl $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ - (if ncgDebugLevel config > 0 + (if ncgDwarfEnabled config then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty ) @@ -141,6 +145,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 +162,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) where isSelfBranch (B (TBlock blockid')) = blockid' == blockid isSelfBranch _ = False + -} asmLbl = blockLbl blockid platform = ncgPlatform config @@ -168,7 +174,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) vcat (map (pprData config) info) $$ pprLabel platform info_lbl $$ c $$ - (if ncgDebugLevel config > 0 + (if ncgDwarfEnabled config then ppr (mkAsmTempEndLabel info_lbl) <> char ':' else empty) -- Make sure the info table has the right .loc for the block @@ -254,8 +260,25 @@ pprDataItem config lit = let bs = doubleToBytes (fromRational r) in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs -pprImm :: Imm -> SDoc + ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit) +floatToBytes :: Float -> [Int] +floatToBytes f + = runST (do + arr <- newArray_ ((0::Int),3) + writeArray arr 0 f + arr <- castFloatToWord8Array arr + i0 <- readArray arr 0 + i1 <- readArray arr 1 + i2 <- readArray arr 2 + i3 <- readArray arr 3 + return (map fromIntegral [i0,i1,i2,i3]) + ) + +castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8) +castFloatToWord8Array = U.castSTUArray + +pprImm :: Imm -> SDoc pprImm (ImmInt i) = int i pprImm (ImmInteger i) = integer i pprImm (ImmCLbl l) = ppr l @@ -339,7 +362,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 +371,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 +482,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 +490,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 +567,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/AArch64/Regs.hs ===================================== @@ -1,4 +1,5 @@ {-# language CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module GHC.CmmToAsm.AArch64.Regs where @@ -9,7 +10,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 ) @@ -17,10 +18,13 @@ import GHC.Types.Unique import GHC.Platform.Regs import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Platform -import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Int ( Int8, Int16, Int32, Int64 ) +import GHC.Driver.Ppr + +-- import Data.Word ( Word8, Word16, Word32, Word64 ) +-- import Data.Int ( Int8, Int16, Int32, Int64 ) allMachRegNos :: [RegNo] allMachRegNos = [0..31] ++ [32..63] @@ -74,7 +78,7 @@ data Imm deriving (Eq, Show) instance Show SDoc where - show = showSDocUnsafe + show = showPprUnsafe . ppr instance Eq SDoc where lhs == rhs = show lhs == show rhs @@ -154,7 +158,7 @@ mkVirtualReg u format = case format of FF32 -> VirtualRegD u FF64 -> VirtualRegD u - _ -> panic "AArch64.mkVirtualReg" + _ -> panic "AArch64.mkVirtualReg" {-# INLINE classOfRealReg #-} classOfRealReg :: RealReg -> RegClass ===================================== compiler/GHC/CmmToAsm/Instr.hs ===================================== @@ -16,8 +16,6 @@ import GHC.Cmm.BlockId import GHC.CmmToAsm.Config -import GHC.Utils.Outputable (SDoc) - import GHC.Stack -- | Holds a list of source and destination registers used by a ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -262,7 +262,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/Linear.hs ===================================== @@ -139,7 +139,6 @@ import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Platform -import GHC.Stack import Data.Maybe import Data.List @@ -151,7 +150,7 @@ import Control.Applicative -- Allocate registers regAlloc - :: Instruction instr + :: (Instruction instr) => NCGConfig -> LiveCmmDecl statics instr -> UniqSM ( NatCmmDecl statics instr @@ -208,7 +207,7 @@ regAlloc _ (CmmProc _ _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: forall instr. Instruction instr + :: forall instr. (Instruction instr) => NCGConfig -> [BlockId] -- ^ entry points -> BlockMap RegSet @@ -261,7 +260,7 @@ linearRegAlloc' config initFreeRegs entry_ids block_live sccs return (blocks, stats, getStackUse stack) -linearRA_SCCs :: (HasCallStack, OutputableRegConstraint freeRegs instr) +linearRA_SCCs :: (OutputableRegConstraint freeRegs instr) => [BlockId] -> BlockMap RegSet -> [NatBasicBlock instr] @@ -296,7 +295,7 @@ linearRA_SCCs entry_ids block_live blocksAcc (CyclicSCC blocks : sccs) more sanity checking to guard against this eventuality. -} -process :: (HasCallStack, OutputableRegConstraint freeRegs instr) +process :: (OutputableRegConstraint freeRegs instr) => [BlockId] -> BlockMap RegSet -> [GenBasicBlock (LiveInstr instr)] @@ -340,7 +339,7 @@ process entry_ids block_live (b@(BasicBlock id _) : blocks) -- | Do register allocation on this basic block -- processBlock - :: (HasCallStack, OutputableRegConstraint freeRegs instr) + :: (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 @@ -387,7 +386,7 @@ initBlock id block_live -- | Do allocation for a sequence of instructions. linearRA - :: (HasCallStack, OutputableRegConstraint freeRegs instr) + :: (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. @@ -414,7 +413,7 @@ linearRA block_live accInstr accFixups id (instr:instrs) -- | Do allocation for a single instruction. raInsn - :: (HasCallStack, OutputableRegConstraint freeRegs instr) + :: (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 @@ -498,7 +497,7 @@ isInReg src assig | Just (InReg _) <- lookupUFM assig src = True genRaInsn :: forall freeRegs instr. - OutputableRegConstraint freeRegs instr + (OutputableRegConstraint freeRegs instr) => BlockMap RegSet -> [instr] -> BlockId @@ -877,7 +876,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 :: (FR freeRegs, Instruction instr) => Bool -> [VirtualReg] -> [instr] ===================================== compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs ===================================== @@ -7,12 +7,13 @@ import GHC.Platform.Reg.Class import GHC.Platform.Reg import GHC.Utils.Outputable +import GHC.Utils.Panic 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 +123,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/Reg/Linear/JoinToTargets.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections import GHC.Data.Graph.Directed import GHC.Utils.Panic -import GHC.Utils.Outputable import GHC.Utils.Monad (concatMapM) import GHC.Types.Unique import GHC.Types.Unique.FM ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -171,6 +171,8 @@ instance Instruction instr => Instruction (InstrSR instr) where pprInstr platform i = ppr (fmap (pprInstr platform) i) + mkComment = fmap Instr . mkComment + -- | An instruction with liveness information. data LiveInstr instr ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -699,9 +699,9 @@ mkLoadInstr config reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of - RcInteger -> (delta, [MOV (archWordFormat is32Bit) - (OpAddr (spRel platform off)) (OpReg reg)]) - RcDouble -> (delta, [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.mkLoadInstr" where platform = ncgPlatform config is32Bit = target32Bit platform ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -104,6 +104,7 @@ platformNcgSupported platform = if ArchPPC -> True ArchPPC_64 {} -> True ArchSPARC -> True + ArchAArch64 -> True _ -> False -- | Will this backend produce an object file on the disk? ===================================== compiler/ghc.cabal.in ===================================== @@ -600,6 +600,7 @@ Library GHC.CmmToAsm.X86.Cond GHC.CmmToAsm.X86.Ppr GHC.CmmToAsm.X86.CodeGen + GHC.CmmToAsm.AArch64 GHC.CmmToAsm.AArch64.Regs GHC.CmmToAsm.AArch64.RegInfo GHC.CmmToAsm.AArch64.Instr ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -146,3 +146,8 @@ -ticky-LNE -ticky-allocd -ticky-dyn-thunk +-fasm-immload +-fasm-jumptables +-fasm-negoffset +-fasm-regoffsets +-fasm-usezeroreg ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -79,10 +79,3 @@ targetSupportsSMP = do , ver < ARMv7 -> return False | goodArch -> return True | otherwise -> return False - -ghcWithNativeCodeGen :: Action Bool -ghcWithNativeCodeGen = do - goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "aarch64"] - badOs <- anyTargetOs ["aix"] - ghcUnreg <- flag GhcUnregisterised - return $ goodArch && not badOs && not ghcUnreg ===================================== rts/StgCRun.c ===================================== @@ -883,41 +883,30 @@ 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. - * Note: The compiler will insert this for us if we specify the - * Clobbered correctly. See below. + * 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. */ + "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 @@ -946,28 +935,26 @@ 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 register - * Note: The compiler will insert this for us if we specify the - * Clobbered correctly. See below. + /* + * restore callee-saves registers. */ - /* Outputs (r) */ + "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" + : "=r" (r) - /* Inputs (f, regbase, RESERVED_C_STACK_BYTES) */ : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES) - /* 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" + : "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28", + "%x16", "%x17", "%x30" ); return r; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec1a9788cff5bff38bbce0441ac43f02decdccae...a378fc67edd6686082494c8ee802de03e68506d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec1a9788cff5bff38bbce0441ac43f02decdccae...a378fc67edd6686082494c8ee802de03e68506d7 You're receiving 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 26 09:37:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 05:37:01 -0400 Subject: [Git][ghc/ghc][master] 2 commits: PmCheck: Big refactor of module structure Message-ID: <5f6f0bbd32760_80b3f84903eed20147153a2@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 18 changed files: - compiler/GHC/Hs/Extension.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/HsToCore/Pmc/Types.hs - + compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Solver.hs - + compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -247,7 +247,7 @@ NoExtCon. But since (1) the field is strict and (2) NoExtCon is an empty data type, there is no possible way to reach the right-hand side of the XHsDecl case. As a result, the coverage checker concludes that the XHsDecl case is inaccessible, so it can be removed. -(See Note [Strict argument type constraints] in GHC.HsToCore.PmCheck.Oracle for +(See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for more on how this works.) Bottom line: if you add a TTG extension constructor that uses NoExtCon, make ===================================== 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 ( addTyCs, covCheckGRHSs ) +import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs ) import GHC.Hs -- lots of things import GHC.Core -- lots of things @@ -159,7 +159,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun -- oracle. -- addTyCs: Add type evidence to the refinement type -- predicate of the coverage checker - -- See Note [Long-distance information] in "GHC.HsToCore.PmCheck" + -- See Note [Long-distance information] in "GHC.HsToCore.Pmc" 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_nablas <- covCheckGRHSs PatBindGuards grhss + = do { rhss_nablas <- pmcGRHSs PatBindGuards grhss ; body_expr <- dsGuarded grhss ty rhss_nablas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat ===================================== 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 ( addTyCs, covCheckGRHSs ) +import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs ) 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_nablas <- covCheckGRHSs PatBindGuards grhss + do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], @@ -490,7 +490,7 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_nablas <- covCheckGRHSs IfAlt grhss + ; rhss_nablas <- pmcGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } ===================================== 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 ( Nablas ) +import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.Core.Type ( Type ) import GHC.Utils.Misc import GHC.Types.SrcLoc ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -34,8 +34,8 @@ import GHC.Hs import GHC.Tc.Utils.Zonk import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad -import GHC.HsToCore.PmCheck -import GHC.HsToCore.PmCheck.Types ( Nablas, initNablas ) +import GHC.HsToCore.Pmc +import GHC.HsToCore.Pmc.Types ( Nablas, initNablas ) import GHC.Core import GHC.Types.Literal import GHC.Core.Utils @@ -771,7 +771,7 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches ; 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 + pmcMatches (DsMatchContext ctxt locn) new_vars matches else pure (initNablasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas @@ -881,7 +881,7 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result -- Pattern match check warnings ; when (isMatchContextPmChecked dflags FromSource ctx) $ addCoreScrutTmCs mb_scrut [var] $ - covCheckPatBind (DsMatchContext ctx locn) var (unLoc pat) + pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] , eqn_orig = FromSource ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -75,7 +75,7 @@ import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon import GHC.HsToCore.Types -import GHC.HsToCore.PmCheck.Types +import GHC.HsToCore.Pmc.Solver.Types (Nablas, initNablas) import GHC.Types.Id import GHC.Unit.Module import GHC.Utils.Outputable ===================================== compiler/GHC/HsToCore/PmCheck.hs → compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -19,18 +19,16 @@ -- -- 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': +-- the entry points such as 'pmcMatches': -- -- 1. Desugar source syntax (like 'LMatch') to guard tree variants (like -- 'GrdMatch'), with one of the desugaring functions (like 'desugarMatch'). +-- See "GHC.HsToCore.Pmc.Desugar". -- 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 'Nablas' are maintained in "GHC.HsToCore.PmCheck.Oracle". +-- 'CheckResult'. See "GHC.HsToCore.Pmc.Check". +-- The normalised refinement types 'Nabla' are tested for inhabitants by +-- "GHC.HsToCore.Pmc.Solver". -- 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') @@ -39,9 +37,9 @@ -- 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 ( +module GHC.HsToCore.Pmc ( -- Checking and printing - covCheckPatBind, covCheckMatches, covCheckGRHSs, + pmcPatBind, pmcMatches, pmcGRHSs, isMatchContextPmChecked, -- See Note [Long-distance information] @@ -52,45 +50,31 @@ module GHC.HsToCore.PmCheck ( import GHC.Prelude -import GHC.HsToCore.PmCheck.Types -import GHC.HsToCore.PmCheck.Oracle -import GHC.HsToCore.PmCheck.Ppr -import GHC.Types.Basic (Origin(..), isGenerated) -import GHC.Core (CoreExpr, Expr(Var,App)) -import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.HsToCore.Pmc.Types +import GHC.HsToCore.Pmc.Utils +import GHC.HsToCore.Pmc.Desugar +import GHC.HsToCore.Pmc.Check +import GHC.HsToCore.Pmc.Solver +import GHC.HsToCore.Pmc.Ppr +import GHC.Types.Basic (Origin(..)) +import GHC.Core (CoreExpr) import GHC.Driver.Session import GHC.Hs -import GHC.Tc.Utils.Zonk (shortCutLit) import GHC.Types.Id -import GHC.Core.ConLike -import GHC.Types.Name -import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Core.DataCon import GHC.Types.Var (EvVar) -import GHC.Core.Coercion -import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) import GHC.Tc.Utils.TcType (evVarPred) -import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr) -import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper) -import GHC.HsToCore.Utils (selectMatchVar) -import GHC.HsToCore.Match.Literal (dsLit, dsOverLit) +import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag import GHC.Data.IOEnv (unsafeInterleaveM) import GHC.Data.OrdList -import GHC.Core.TyCo.Rep -import GHC.Core.Type -import GHC.HsToCore.Utils (isTrueLHsExpr) -import GHC.Data.Maybe -import qualified GHC.LanguageExtensions as LangExt -import GHC.Utils.Monad (concatMapM, mapMaybeM) +import GHC.Utils.Monad (mapMaybeM) -import Control.Monad (when, forM_, zipWithM) -import Data.List (elemIndex) +import Control.Monad (when, forM_) import qualified Data.Semigroup as Semi import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE @@ -112,30 +96,30 @@ getLdiNablas = do 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 +pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () +-- See Note [pmcPatBind only checks PatBindRhs] +pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do missing <- getLdiNablas pat_bind <- desugarPatBind loc var p - tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) + tracePm "pmcPatBind {" (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 () +pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and -- in @MultiIf@ expressions. Returns the 'Nablas' covered by the RHSs. -covCheckGRHSs +pmcGRHSs :: HsMatchContext GhcRn -- ^ Match context, for warning messages -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check -> DsM (NonEmpty Nablas) -- ^ Covered 'Nablas' for each RHS, for long -- distance info -covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do +pmcGRHSs 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 <- getLdiNablas - tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt + tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 (pprGRHSs hs_ctxt guards $$ ppr missing)) @@ -159,18 +143,18 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- 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 +pmcMatches :: DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. -covCheckMatches ctxt vars matches = do +pmcMatches 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 <- getLdiNablas - tracePm "covCheckMatches {" $ + tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 (vcat (map ppr matches) $$ ppr missing) @@ -190,9 +174,9 @@ covCheckMatches ctxt vars matches = do formatReportWarnings cirbsMatchGroup ctxt vars result return (NE.toList (ldiMatchGroup (cr_ret result))) -{- Note [covCheckPatBind only checks PatBindRhs] +{- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - at covCheckPatBind@'s sole purpose is to check vanilla pattern bindings, like + at pmcPatBind@'s sole purpose is to check vanilla pattern bindings, like @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 @@ -206,837 +190,6 @@ go through this function. It makes no sense to do coverage checking there: 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: - - 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 Nabla 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 - = -- | @PmCon x K dicts args@ corresponds to a @K dicts args <- x@ guard. - -- The @args@ are bound in this construct, the @x@ is just a use. - -- For the arguments' meaning see 'GHC.Hs.Pat.ConPatOut'. - PmCon { - pm_id :: !Id, - pm_con_con :: !PmAltCon, - pm_con_tvs :: ![TyVar], - pm_con_dicts :: ![EvVar], - pm_con_args :: ![Id] - } - - -- | @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]. - | PmBang { - pm_id :: !Id, - _pm_loc :: !(Maybe SrcInfo) - } - - -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually - -- /binds/ @x at . - | PmLet { - pm_id :: !Id, - _pm_let_expr :: !CoreExpr - } - --- | Should not be user-facing. -instance Outputable PmGrd where - ppr (PmCon x alt _tvs _con_dicts con_args) - = hsep [ppr alt, hsep (map ppr con_args), text "<-", ppr x] - ppr (PmBang x _loc) = char '!' <> ppr x - ppr (PmLet x expr) = hsep [text "let", ppr x, text "=", ppr expr] - -type GrdVec = [PmGrd] - -data Precision = Approximate | Precise - deriving (Eq, Show) - -instance Outputable Precision where - ppr = text . show - -instance Semi.Semigroup Precision where - Precise <> Precise = Precise - _ <> _ = Approximate - -instance Monoid Precision where - mempty = Precise - mappend = (Semi.<>) - --- --- * 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 - --- | Redundancy sets, used to determine redundancy of RHSs and bang patterns --- (later digested into a 'CIRB'). -data RedSets - = RedSets - { rs_cov :: !Nablas - -- ^ The /Covered/ set; the set of values reaching a particular program - -- point. - , 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 (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]. - } - --- 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] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - - f :: Bool -> Int - f True = 1 - f !x = 2 - -Whenever we fall through to the second equation, we will already have evaluated -the argument. Thus, the bang pattern serves no purpose and should be warned -about. We call this kind of bang patterns "dead". 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; see below. - -We can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable -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. - -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. --} - --- --- * Desugaring source syntax to guard trees --- - --- | Smart constructor that eliminates trivial lets -mkPmLetVar :: Id -> Id -> GrdVec -mkPmLetVar x y | x == y = [] -mkPmLetVar x y = [PmLet x (Var y)] - --- | ADT constructor pattern => no existentials, no local constraints -vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd -vanillaConGrd scrut con arg_ids = - PmCon { pm_id = scrut, pm_con_con = PmAltConLike (RealDataCon con) - , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = arg_ids } - --- | Creates a 'GrdVec' refining a match var of list type to a list, --- where list fields are matched against the incoming tagged 'GrdVec's. --- For example: --- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@ --- to --- @"[(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 --- See Note [Order of guards matter] for why we need to intertwine guards --- on list elements. -mkListGrds a [] = pure [vanillaConGrd a nilDataCon []] -mkListGrds a ((x, head_grds):xs) = do - b <- mkPmId (idType a) - tail_grds <- mkListGrds b xs - pure $ vanillaConGrd a consDataCon [x, b] : head_grds ++ tail_grds - --- | Create a 'GrdVec' refining a match variable to a 'PmLit'. -mkPmLitGrds :: Id -> PmLit -> DsM GrdVec -mkPmLitGrds x (PmLit _ (PmLitString s)) = do - -- 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 - -- here. See Note [Representation of Strings in TmState] in - -- GHC.HsToCore.PmCheck.Oracle - vars <- traverse mkPmId (take (lengthFS s) (repeat charTy)) - let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c)) - char_grdss <- zipWithM mk_char_lit vars (unpackFS s) - mkListGrds x (zip vars char_grdss) -mkPmLitGrds x lit = do - let grd = PmCon { pm_id = x - , pm_con_con = PmAltLit lit - , pm_con_tvs = [] - , pm_con_dicts = [] - , pm_con_args = [] } - pure [grd] - --- | @desugarPat _ x pat@ transforms @pat@ into a 'GrdVec', where --- the variable representing the match is @x at . -desugarPat :: Id -> Pat GhcTc -> DsM GrdVec -desugarPat x pat = case pat of - WildPat _ty -> pure [] - VarPat _ y -> pure (mkPmLetVar (unLoc y) x) - 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 :) <$> desugarLPat x p - where pm_loc = Just (L l (ppr p')) - - -- (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 ++) <$> desugarLPat y p - - SigPat _ p _ty -> desugarLPat x p - - -- 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 -> desugarPat x p - | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p - | otherwise -> do - (y, grds) <- desugarPatV p - wrap_rhs_y <- dsHsWrapper wrapper - pure (PmLet y (wrap_rhs_y (Var x)) : grds) - - -- (n + k) ===> let b = x >= k, True <- b, let n = x-k - NPlusKPat _pat_ty (L _ n) k1 k2 ge minus -> do - b <- mkPmId boolTy - let grd_b = vanillaConGrd b trueDataCon [] - [ke1, ke2] <- traverse dsOverLit [unLoc k1, k2] - rhs_b <- dsSyntaxExpr ge [Var x, ke1] - rhs_n <- dsSyntaxExpr minus [Var x, ke2] - pure [PmLet b rhs_b, grd_b, PmLet n rhs_n] - - -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat - ViewPat _arg_ty lexpr pat -> do - (y, grds) <- desugarLPatV pat - fun <- dsLExpr lexpr - pure $ PmLet y (App fun (Var x)) : grds - - -- list - ListPat (ListPatTc _elem_ty Nothing) ps -> - desugarListPat x ps - - -- overloaded list - ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do - dflags <- getDynFlags - case splitListTyConApp_maybe pat_ty of - Just _e_ty - | not (xopt LangExt.RebindableSyntax dflags) - -- Just desugar it as a regular ListPat - -> desugarListPat x pats - _ -> do - y <- mkPmId (mkListTy elem_ty) - grds <- desugarListPat y pats - rhs_y <- dsSyntaxExpr to_list [Var x] - pure $ PmLet y rhs_y : grds - - -- (a) In the presence of RebindableSyntax, we don't know anything about - -- `toList`, we should treat `ListPat` as any other view pattern. - -- - -- (b) In the absence of RebindableSyntax, - -- - If the pat_ty is `[a]`, then we treat the overloaded list pattern - -- as ordinary list pattern. Although we can give an instance - -- `IsList [Int]` (more specific than the default `IsList [a]`), in - -- practice, we almost never do that. We assume the `to_list` is - -- the `toList` from `instance IsList [a]`. - -- - -- - Otherwise, we treat the `ListPat` as ordinary view pattern. - -- - -- See #14547, especially comment#9 and comment#10. - - ConPat { pat_con = L _ con - , pat_args = ps - , pat_con_ext = ConPatTc - { cpt_arg_tys = arg_tys - , cpt_tvs = ex_tvs - , cpt_dicts = dicts - } - } -> do - 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" - -- We inline the Literal short cut for @ty@ here, because @ty@ is more - -- precise than the field of OverLitTc, which is all that dsOverLit (which - -- normally does the literal short cut) can look at. Also @ty@ matches the - -- type of the scrutinee, so info on both pattern and scrutinee (for which - -- short cutting in dsOverLit works properly) is overloaded iff either is. - dflags <- getDynFlags - let platform = targetPlatform dflags - core_expr <- case olit of - OverLit{ ol_val = val, ol_ext = OverLitTc rebindable _ } - | not rebindable - , Just expr <- shortCutLit platform val ty - -> dsExpr expr - _ -> dsOverLit olit - let lit = expectJust "failed to detect OverLit" (coreExprAsPmLit core_expr) - let lit' = case mb_neg of - Just _ -> expectJust "failed to negate lit" (negatePmLit lit) - Nothing -> lit - mkPmLitGrds x lit' - - LitPat _ lit -> do - core_expr <- dsLit (convertLit lit) - let lit = expectJust "failed to detect Lit" (coreExprAsPmLit core_expr) - mkPmLitGrds x lit - - TuplePat _tys pats boxity -> do - (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) <- 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 - - SplicePat {} -> panic "Check.desugarPat: SplicePat" - --- | 'desugarPat', but also select and return a new match var. -desugarPatV :: Pat GhcTc -> DsM (Id, GrdVec) -desugarPatV pat = do - x <- selectMatchVar Many pat - grds <- desugarPat x pat - pure (x, grds) - -desugarLPat :: Id -> LPat GhcTc -> DsM GrdVec -desugarLPat x = desugarPat x . unLoc - --- | 'desugarLPat', but also select and return a new match var. -desugarLPatV :: LPat GhcTc -> DsM (Id, GrdVec) -desugarLPatV = desugarPatV . unLoc - --- | @desugarListPat _ x [p1, ..., pn]@ is basically --- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever --- constructing the 'ConPatOut's. -desugarListPat :: Id -> [LPat GhcTc] -> DsM GrdVec -desugarListPat x pats = do - vars_and_grdss <- traverse desugarLPatV pats - mkListGrds x vars_and_grdss - --- | Desugar a constructor pattern -desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] - -> [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]) - RecCon (HsRecFields fs _) -> go_field_pats (rec_field_ps fs) - where - -- The actual argument types (instantiated) - arg_tys = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs) - - -- Extract record field patterns tagged by field index from a list of - -- LHsRecField - rec_field_ps fs = map (tagged_pat . unLoc) fs - 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 desugar to field index. - orig_lbls = map flSelector $ conLikeFieldLabels con - 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 - -- 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 and bring them in order afterwards. - let trans_pat (n, pat) = do - (var, pvec) <- desugarLPatV pat - pure ((n, var), pvec) - (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats - - let get_pat_id n ty = case lookup n tagged_vars of - Just var -> pure var - Nothing -> mkPmId ty - - -- 1. the constructor pattern match itself - arg_ids <- zipWithM get_pat_id [0..] arg_tys - let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids - - -- 2. guards from field selector patterns - let arg_grds = concat arg_grdss - - -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids) - pure (con_grd : arg_grds) - -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; @ -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 - -> desugarLPat y p - rhs -> do - (x, grds) <- desugarLPatV p - pure (PmLet x rhs : grds) - --- | Desugar a boolean guard --- @e ==> let x = e; True <- x@ -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 - -- GrdVec for efficiency - | otherwise = dsLExpr e >>= \case - Var y - | Nothing <- isDataConId_maybe y - -- Omit the let by matching on y - -> pure [vanillaConGrd y trueDataCon []] - rhs -> do - x <- mkPmId boolTy - 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 :: Char, b :: Int } - f :: T -> () - 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. - -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]@. - -Note [Order of guards matters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Similar to Note [Field match order for RecCon], the order in which the guards -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 desugar the second clause as - - [x:xs' <- xs, [] <- xs', 0 <- x] - -We will say that the second clause only has an inaccessible RHS. That's because -we force the tail of the list before comparing its head! So the correct -translation would have been - - [x:xs' <- xs, 0 <- x, [] <- xs'] - -And we have to take in the guards on list cells into @mkListGrds at . - -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 -desugared `CoPat`s: - - pat |> co ===> x (pat <- (x |> co)) - -Why did we do this seemingly unnecessary expansion in the first place? -The reason is that the type of @pat |> co@ (which is the type of the value -abstraction we match against) might be different than that of @pat at . Data -instances such as @Sing (a :: Bool)@ are a good example of this: If we would -just drop the coercion, we'd get a type error when matching @pat@ against its -value abstraction, with the result being that pmIsSatisfiable decides that every -possible data constructor fitting @pat@ is rejected as uninhabitated, leading to -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. --} - --- --- * Coverage checking guard trees into annotated trees --- - --- | Pattern-match coverage check result -data CheckResult a - = CheckResult - { cr_ret :: !a - -- ^ A hole for redundancy info and covered sets. - , 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 - -- ^ 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 'Nablas'. -addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas -addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas - --- | 'addPmCtsNablas' for a single 'PmCt'. -addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas -addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) - --- | 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 <$> generateInhabitingPatterns 1 ds at . -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 :: Nablas -> 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 'Nabla's in @new@ --- is exceeding the given @limit@ and the @old@ number of 'Nabla's. --- See Note [Countering exponential blowup]. -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) - -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 <- addPhiCtNablas inc (PhiCoreCt 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 <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt 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: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x con tvs dicts args -> do - !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) - else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - tracePm "check:Con" $ vcat - [ ppr grd - , ppr inc - , hang (text "div") 2 (ppr div) - , hang (text "matched") 2 (ppr matched) - , hang (text "uncov") 2 (ppr uncov) - ] - 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 - 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 } - -checkMatchGroup :: PmMatchGroup Pre -> CheckAction (PmMatchGroup Post) -checkMatchGroup (PmMatchGroup matches) = - PmMatchGroup <$> checkSequence checkMatch matches - -checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) -checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = - leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) - -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 <- addPhiCtNablas inc (PhiNotBotCt 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 Nablas 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 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 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 -{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! -} -- @@ -1188,14 +341,14 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars when (approx && (exists_u || exists_i)) $ putSrcSpanDs loc (warnDs NoReason approx_msg) - when exists_b $ forM_ redundant_bangs $ \(L l q) -> do + when exists_b $ forM_ redundant_bangs $ \(SrcInfo (L l q)) -> do putSrcSpanDs l (warnDs (Reason Opt_WarnRedundantBangPatterns) (pprEqn q "has redundant bang")) - when exists_r $ forM_ redundant_rhss $ \(L l q) -> do + when exists_r $ forM_ redundant_rhss $ \(SrcInfo (L l q)) -> do putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns) (pprEqn q "is redundant")) - when exists_i $ forM_ inaccessible_rhss $ \(L l q) -> do + when exists_i $ forM_ inaccessible_rhss $ \(SrcInfo (L l q)) -> do putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns) (pprEqn q "has inaccessible right hand side")) @@ -1204,7 +357,7 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars where flag_i = overlapping dflags kind flag_u = exhaustive dflags kind - flag_b = redundant_bang dflags + flag_b = redundantBang dflags flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind) maxPatterns = maxUncoveredPatterns dflags @@ -1263,105 +416,7 @@ pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun _ -> (pprMatchContext kind, \ pp -> pp) -- --- * Utilities --- - --- | All warning flags that need to run the pattern match checker. -allPmCheckWarnings :: [WarningFlag] -allPmCheckWarnings = - [ Opt_WarnIncompletePatterns - , Opt_WarnIncompleteUniPatterns - , Opt_WarnIncompletePatternsRecUpd - , Opt_WarnOverlappingPatterns - ] - --- | Check whether the redundancy checker should run (redundancy only) -overlapping :: DynFlags -> HsMatchContext id -> Bool --- See Note [Inaccessible warnings for record updates] -overlapping _ RecUpd = False -overlapping dflags _ = wopt Opt_WarnOverlappingPatterns dflags - --- | Check whether the exhaustiveness checker should run (exhaustiveness only) -exhaustive :: DynFlags -> HsMatchContext id -> Bool -exhaustive dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag - --- | Check whether unnecessary bangs should be warned about -redundant_bang :: DynFlags -> Bool -redundant_bang dflags = wopt Opt_WarnRedundantBangPatterns dflags - --- | Denotes whether an exhaustiveness check is supported, and if so, --- via which 'WarningFlag' it's controlled. --- Returns 'Nothing' if check is not supported. -exhaustiveWarningFlag :: HsMatchContext id -> Maybe WarningFlag -exhaustiveWarningFlag (FunRhs {}) = Just Opt_WarnIncompletePatterns -exhaustiveWarningFlag CaseAlt = Just Opt_WarnIncompletePatterns -exhaustiveWarningFlag IfAlt = Just Opt_WarnIncompletePatterns -exhaustiveWarningFlag LambdaExpr = Just Opt_WarnIncompleteUniPatterns -exhaustiveWarningFlag PatBindRhs = Just Opt_WarnIncompleteUniPatterns -exhaustiveWarningFlag PatBindGuards = Just Opt_WarnIncompletePatterns -exhaustiveWarningFlag ProcExpr = Just Opt_WarnIncompleteUniPatterns -exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd -exhaustiveWarningFlag ThPatSplice = Nothing -exhaustiveWarningFlag PatSyn = Nothing -exhaustiveWarningFlag ThPatQuote = Nothing --- Don't warn about incomplete patterns in list comprehensions, pattern guards --- etc. They are often *supposed* to be incomplete -exhaustiveWarningFlag (StmtCtxt {}) = Nothing - --- | 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 - --- | 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 +-- * Adding external long-distance information -- -- | Locally update 'dsl_nablas' with the given action, but defer evaluation ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -0,0 +1,276 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | Coverage checking step of the +-- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989). +-- +-- Coverage check guard trees (like @'PmMatch' 'Pre'@) to get a +-- 'CheckResult', containing +-- +-- 1. The set of uncovered values, 'cr_uncov' +-- 2. And an annotated tree variant (like @'PmMatch' 'Post'@) that captures +-- redundancy and inaccessibility information as 'RedSets' annotations +-- +-- Basically the UA function from Section 5.1, which is an optimised +-- interleaving of U and A from Section 3.2 (Figure 5). +-- The Normalised Refinement Types 'Nablas' are maintained in +-- "GHC.HsToCore.Pmc.Solver". +module GHC.HsToCore.Pmc.Check ( + CheckAction(..), + checkMatchGroup, checkGRHSs, checkPatBind, checkEmptyCase + ) where + +#include "HsVersions.h" + +import GHC.Prelude + +import GHC.HsToCore.Monad ( DsM ) +import GHC.HsToCore.Pmc.Types +import GHC.HsToCore.Pmc.Utils +import GHC.HsToCore.Pmc.Solver +import GHC.Driver.Session +import GHC.Utils.Outputable +import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Data.OrdList + +import qualified Data.Semigroup as Semi +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.Coerce + +-- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. +newtype CheckAction a = CA { unCA :: Nablas -> 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 'Nabla's in @new@ +-- is exceeding the given @limit@ and the @old@ number of 'Nabla's. +-- See Note [Countering exponential blowup]. +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) + +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)) + +emptyRedSets :: RedSets +-- Semigroup instance would be misleading! +emptyRedSets = RedSets mempty mempty mempty + +checkGrd :: PmGrd -> CheckAction RedSets +checkGrd grd = CA $ \inc -> case grd of + -- let x = e: Refine with x ~ e + PmLet x e -> do + matched <- addPhiCtNablas inc (PhiCoreCt 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 <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt 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: Fall through on x ≁ K and refine with x ~ K ys and type info + PmCon x con tvs dicts args -> do + !div <- if isPmAltConMatchStrict con + then addPhiCtNablas inc (PhiBotCt x) + else pure mempty + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] + 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 + 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 } + +checkMatchGroup :: PmMatchGroup Pre -> CheckAction (PmMatchGroup Post) +checkMatchGroup (PmMatchGroup matches) = + PmMatchGroup <$> checkSequence checkMatch matches + +checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) +checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = + leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) + +checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) +checkGRHSs = checkSequence checkGRHS + +checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) +checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = + flip PmGRHS rhs_info <$> checkGrds grds + +checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase +-- See Note [Checking EmptyCase] +checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do + unc <- addPhiCtNablas inc (PhiNotBotCt var) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + +checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind = coerce checkGRHS + +{- 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 Nabla and check if there are any values left to match on. + +Note [Dead bang patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + f :: Bool -> Int + f True = 1 + f !x = 2 + +Whenever we fall through to the second equation, we will already have evaluated +the argument. Thus, the bang pattern serves no purpose and should be warned +about. We call this kind of bang patterns "dead". 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; see below. + +We can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable +where the PmBang appears in 'checkGrd'. If not, then clearly the bang is +dead. So for a source bang, we add the refined Nabla and the source info to +the 'RedSet's 'rs_bangs'. When collecting stuff to warn, we test that Nabla for +inhabitants. If it's empty, we'll warn that it's redundant. + +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. + +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 Nablas 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 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 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 +{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! +-} ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -0,0 +1,450 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | Desugaring step of the +-- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989). +-- +-- Desugars Haskell source syntax into guard tree variants Pm*. +-- In terms of the paper, this module is concerned with Sections 3.1, Figure 4, +-- in particular. +module GHC.HsToCore.Pmc.Desugar ( + desugarPatBind, desugarGRHSs, desugarMatches, desugarEmptyCase + ) where + +#include "HsVersions.h" + +import GHC.Prelude + +import GHC.HsToCore.Pmc.Types +import GHC.HsToCore.Pmc.Utils +import GHC.Core (Expr(Var,App)) +import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Driver.Session +import GHC.Hs +import GHC.Tc.Utils.Zonk (shortCutLit) +import GHC.Types.Id +import GHC.Core.ConLike +import GHC.Types.Name +import GHC.Builtin.Types +import GHC.Types.SrcLoc +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Core.DataCon +import GHC.Types.Var (EvVar) +import GHC.Core.Coercion +import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) +import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr) +import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper) +import GHC.HsToCore.Utils (selectMatchVar) +import GHC.HsToCore.Match.Literal (dsLit, dsOverLit) +import GHC.HsToCore.Monad +import GHC.Core.TyCo.Rep +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 Control.Monad (zipWithM) +import Data.List (elemIndex) +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE + +-- | Smart constructor that eliminates trivial lets +mkPmLetVar :: Id -> Id -> [PmGrd] +mkPmLetVar x y | x == y = [] +mkPmLetVar x y = [PmLet x (Var y)] + +-- | ADT constructor pattern => no existentials, no local constraints +vanillaConGrd :: Id -> DataCon -> [Id] -> PmGrd +vanillaConGrd scrut con arg_ids = + PmCon { pm_id = scrut, pm_con_con = PmAltConLike (RealDataCon con) + , pm_con_tvs = [], pm_con_dicts = [], pm_con_args = arg_ids } + +-- | Creates a '[PmGrd]' refining a match var of list type to a list, +-- where list fields are matched against the incoming tagged '[PmGrd]'s. +-- For example: +-- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@ +-- to +-- @"[(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, [PmGrd])] -> DsM [PmGrd] +-- See Note [Order of guards matter] for why we need to intertwine guards +-- on list elements. +mkListGrds a [] = pure [vanillaConGrd a nilDataCon []] +mkListGrds a ((x, head_grds):xs) = do + b <- mkPmId (idType a) + tail_grds <- mkListGrds b xs + pure $ vanillaConGrd a consDataCon [x, b] : head_grds ++ tail_grds + +-- | Create a '[PmGrd]' refining a match variable to a 'PmLit'. +mkPmLitGrds :: Id -> PmLit -> DsM [PmGrd] +mkPmLitGrds x (PmLit _ (PmLitString s)) = do + -- 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.Pmc.Solver.trySolve' and + -- 'GHC.HsToCore.Pmc.Solver.addRefutableAltCon', but it's so much simpler + -- here. See Note [Representation of Strings in TmState] in + -- GHC.HsToCore.Pmc.Solver + vars <- traverse mkPmId (take (lengthFS s) (repeat charTy)) + let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c)) + char_grdss <- zipWithM mk_char_lit vars (unpackFS s) + mkListGrds x (zip vars char_grdss) +mkPmLitGrds x lit = do + let grd = PmCon { pm_id = x + , pm_con_con = PmAltLit lit + , pm_con_tvs = [] + , pm_con_dicts = [] + , pm_con_args = [] } + pure [grd] + +-- | @desugarPat _ x pat@ transforms @pat@ into a '[PmGrd]', where +-- the variable representing the match is @x at . +desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd] +desugarPat x pat = case pat of + WildPat _ty -> pure [] + VarPat _ y -> pure (mkPmLetVar (unLoc y) x) + 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 :) <$> desugarLPat x p + where pm_loc = Just (SrcInfo (L l (ppr p'))) + + -- (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 ++) <$> desugarLPat y p + + SigPat _ p _ty -> desugarLPat x p + + -- 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 -> desugarPat x p + | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p + | otherwise -> do + (y, grds) <- desugarPatV p + wrap_rhs_y <- dsHsWrapper wrapper + pure (PmLet y (wrap_rhs_y (Var x)) : grds) + + -- (n + k) ===> let b = x >= k, True <- b, let n = x-k + NPlusKPat _pat_ty (L _ n) k1 k2 ge minus -> do + b <- mkPmId boolTy + let grd_b = vanillaConGrd b trueDataCon [] + [ke1, ke2] <- traverse dsOverLit [unLoc k1, k2] + rhs_b <- dsSyntaxExpr ge [Var x, ke1] + rhs_n <- dsSyntaxExpr minus [Var x, ke2] + pure [PmLet b rhs_b, grd_b, PmLet n rhs_n] + + -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat + ViewPat _arg_ty lexpr pat -> do + (y, grds) <- desugarLPatV pat + fun <- dsLExpr lexpr + pure $ PmLet y (App fun (Var x)) : grds + + -- list + ListPat (ListPatTc _elem_ty Nothing) ps -> + desugarListPat x ps + + -- overloaded list + ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do + dflags <- getDynFlags + case splitListTyConApp_maybe pat_ty of + Just _e_ty + | not (xopt LangExt.RebindableSyntax dflags) + -- Just desugar it as a regular ListPat + -> desugarListPat x pats + _ -> do + y <- mkPmId (mkListTy elem_ty) + grds <- desugarListPat y pats + rhs_y <- dsSyntaxExpr to_list [Var x] + pure $ PmLet y rhs_y : grds + + -- (a) In the presence of RebindableSyntax, we don't know anything about + -- `toList`, we should treat `ListPat` as any other view pattern. + -- + -- (b) In the absence of RebindableSyntax, + -- - If the pat_ty is `[a]`, then we treat the overloaded list pattern + -- as ordinary list pattern. Although we can give an instance + -- `IsList [Int]` (more specific than the default `IsList [a]`), in + -- practice, we almost never do that. We assume the `to_list` is + -- the `toList` from `instance IsList [a]`. + -- + -- - Otherwise, we treat the `ListPat` as ordinary view pattern. + -- + -- See #14547, especially comment#9 and comment#10. + + ConPat { pat_con = L _ con + , pat_args = ps + , pat_con_ext = ConPatTc + { cpt_arg_tys = arg_tys + , cpt_tvs = ex_tvs + , cpt_dicts = dicts + } + } -> do + 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" + -- We inline the Literal short cut for @ty@ here, because @ty@ is more + -- precise than the field of OverLitTc, which is all that dsOverLit (which + -- normally does the literal short cut) can look at. Also @ty@ matches the + -- type of the scrutinee, so info on both pattern and scrutinee (for which + -- short cutting in dsOverLit works properly) is overloaded iff either is. + dflags <- getDynFlags + let platform = targetPlatform dflags + core_expr <- case olit of + OverLit{ ol_val = val, ol_ext = OverLitTc rebindable _ } + | not rebindable + , Just expr <- shortCutLit platform val ty + -> dsExpr expr + _ -> dsOverLit olit + let lit = expectJust "failed to detect OverLit" (coreExprAsPmLit core_expr) + let lit' = case mb_neg of + Just _ -> expectJust "failed to negate lit" (negatePmLit lit) + Nothing -> lit + mkPmLitGrds x lit' + + LitPat _ lit -> do + core_expr <- dsLit (convertLit lit) + let lit = expectJust "failed to detect Lit" (coreExprAsPmLit core_expr) + mkPmLitGrds x lit + + TuplePat _tys pats boxity -> do + (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) <- 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 + + SplicePat {} -> panic "Check.desugarPat: SplicePat" + +-- | 'desugarPat', but also select and return a new match var. +desugarPatV :: Pat GhcTc -> DsM (Id, [PmGrd]) +desugarPatV pat = do + x <- selectMatchVar Many pat + grds <- desugarPat x pat + pure (x, grds) + +desugarLPat :: Id -> LPat GhcTc -> DsM [PmGrd] +desugarLPat x = desugarPat x . unLoc + +-- | 'desugarLPat', but also select and return a new match var. +desugarLPatV :: LPat GhcTc -> DsM (Id, [PmGrd]) +desugarLPatV = desugarPatV . unLoc + +-- | @desugarListPat _ x [p1, ..., pn]@ is basically +-- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever +-- constructing the 'ConPatOut's. +desugarListPat :: Id -> [LPat GhcTc] -> DsM [PmGrd] +desugarListPat x pats = do + vars_and_grdss <- traverse desugarLPatV pats + mkListGrds x vars_and_grdss + +-- | Desugar a constructor pattern +desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] + -> [EvVar] -> HsConPatDetails GhcTc -> DsM [PmGrd] +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) + where + -- The actual argument types (instantiated) + arg_tys = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs) + + -- Extract record field patterns tagged by field index from a list of + -- LHsRecField + rec_field_ps fs = map (tagged_pat . unLoc) fs + 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 desugar to field index. + orig_lbls = map flSelector $ conLikeFieldLabels con + 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 + -- 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 and bring them in order afterwards. + let trans_pat (n, pat) = do + (var, pvec) <- desugarLPatV pat + pure ((n, var), pvec) + (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats + + let get_pat_id n ty = case lookup n tagged_vars of + Just var -> pure var + Nothing -> mkPmId ty + + -- 1. the constructor pattern match itself + arg_ids <- zipWithM get_pat_id [0..] arg_tys + let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids + + -- 2. guards from field selector patterns + let arg_grds = concat arg_grdss + + -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids) + pure (con_grd : arg_grds) + +desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre) +-- See 'GrdPatBind' for how this simply repurposes GrdGRHS. +desugarPatBind loc var pat = + PmPatBind . flip PmGRHS (SrcInfo (L loc (ppr pat))) . GrdVec <$> 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 = GrdVec 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 = GrdVec grds, pg_rhs = SrcInfo rhs_info } + +-- | Desugar a guard statement to a '[PmGrd]' +desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] +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 [PmGrd] +desugarLet _binds = return [] + +-- | Desugar a pattern guard +-- @pat <- e ==> let x = e; @ +desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM [PmGrd] +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 + -> desugarLPat y p + rhs -> do + (x, grds) <- desugarLPatV p + pure (PmLet x rhs : grds) + +-- | Desugar a boolean guard +-- @e ==> let x = e; True <- x@ +desugarBoolGuard :: LHsExpr GhcTc -> DsM [PmGrd] +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 + -- [PmGrd] for efficiency + | otherwise = dsLExpr e >>= \case + Var y + | Nothing <- isDataConId_maybe y + -- Omit the let by matching on y + -> pure [vanillaConGrd y trueDataCon []] + rhs -> do + x <- mkPmId boolTy + 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 :: Char, b :: Int } + f :: T -> () + 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. + +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]@. + +Note [Order of guards matters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Similar to Note [Field match order for RecCon], the order in which the guards +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 desugar the second clause as + + [x:xs' <- xs, [] <- xs', 0 <- x] + +We will say that the second clause only has an inaccessible RHS. That's because +we force the tail of the list before comparing its head! So the correct +translation would have been + + [x:xs' <- xs, 0 <- x, [] <- xs'] + +And we have to take in the guards on list cells into @mkListGrds at . + +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 +desugared `CoPat`s: + + pat |> co ===> x (pat <- (x |> co)) + +Why did we do this seemingly unnecessary expansion in the first place? +The reason is that the type of @pat |> co@ (which is the type of the value +abstraction we match against) might be different than that of @pat at . Data +instances such as @Sing (a :: Bool)@ are a good example of this: If we would +just drop the coercion, we'd get a type error when matching @pat@ against its +value abstraction, with the result being that pmIsSatisfiable decides that every +possible data constructor fitting @pat@ is rejected as uninhabitated, leading to +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. +-} ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -4,7 +4,7 @@ -- | Provides factilities for pretty-printing 'Nabla's in a way appropriate for -- user facing pattern match warnings. -module GHC.HsToCore.PmCheck.Ppr ( +module GHC.HsToCore.Pmc.Ppr ( pprUncovered ) where @@ -26,8 +26,8 @@ import GHC.Utils.Misc import GHC.Data.Maybe import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) -import GHC.HsToCore.PmCheck.Types -import GHC.HsToCore.PmCheck.Oracle +import GHC.HsToCore.Pmc.Types +import GHC.HsToCore.Pmc.Solver -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its -- components and refutable shapes associated to any mentioned variables. @@ -93,25 +93,25 @@ Unhandled constraints that refer to HsExpr are typically ignored by the solver (it does not even substitute in HsExpr so they are even printed as wildcards). Additionally, the oracle returns a substitution if it succeeds so we apply this substitution to the vectors before printing them out (see function `pprOne' in -"GHC.HsToCore.PmCheck") to be more precise. +"GHC.HsToCore.Pmc") to be more precise. -} -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Nabla -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) +prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon]) prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList where - attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts nabla u)) + attach_refuts (u, (x, sdoc)) = (u, (sdoc, lookupRefuts nabla x)) -type PmPprM a = RWS Nabla () (DIdEnv SDoc, [SDoc]) a +type PmPprM a = RWS Nabla () (DIdEnv (Id, 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 :: Nabla -> PmPprM a -> (a, DIdEnv SDoc) +runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc)) runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of (a, (renamings, _), _) -> (a, renamings) @@ -122,9 +122,9 @@ getCleanName x = do (renamings, name_supply) <- get let (clean_name:name_supply') = name_supply case lookupDVarEnv renamings x of - Just nm -> pure nm + Just (_, nm) -> pure nm Nothing -> do - put (extendDVarEnv renamings x clean_name, name_supply') + put (extendDVarEnv renamings x (x, clean_name), name_supply') pure clean_name checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached @@ -139,8 +139,8 @@ checkRefuts x = do -- underscores. Even with a type signature, if it's not too noisy. pprPmVar :: PprPrec -> Id -> PmPprM SDoc -- Type signature is "too noisy" by my definition if it needs to parenthesize. --- I like "not matched: _ :: Proxy (DIdEnv SDoc)", --- but I don't like "not matched: (_ :: stuff) (_:_) (_ :: Proxy (DIdEnv SDoc))" +-- I like "not matched: _ :: Proxy (DIdEnv (Id, SDoc))", +-- but I don't like "not matched: (_ :: stuff) (_:_) (_ :: Proxy (DIdEnv (Id, 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 ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -7,41 +7,47 @@ Authors: George Karachalias {-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf, ScopedTypeVariables, MagicHash #-} --- | The pattern match oracle. The main export of the module are the functions --- 'addPhiCts' for adding facts to the oracle, and 'generateInhabitingPatterns' to turn a --- 'Nabla' into a concrete evidence for an equation. +-- | Model refinements type as per the +-- [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989). +-- The main export of the module are the functions 'addPhiCtsNablas' for adding +-- facts to the oracle, 'isInhabited' to check if a refinement type is inhabited +-- and 'generateInhabitingPatterns' to turn a 'Nabla' into a concrete pattern +-- 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 directly as a normalised refinement type 'Nabla'. -module GHC.HsToCore.PmCheck.Oracle ( +-- In terms of the LYG paper, this module is concerned with Sections 3.4, 3.6 +-- and 3.7. E.g., it represents refinement types directly as a bunch of +-- normalised refinement types 'Nabla'. +module GHC.HsToCore.Pmc.Solver ( - DsM, tracePm, mkPmId, - Nabla, initNablas, lookupRefuts, lookupSolution, + Nabla, Nablas(..), initNablas, + lookupRefuts, lookupSolution, PhiCt(..), PhiCts, + addPhiCtNablas, + addPhiCtsNablas, - addPhiCts, -- Add a constraint to the oracle. + isInhabited, generateInhabitingPatterns + ) where #include "HsVersions.h" import GHC.Prelude -import GHC.HsToCore.PmCheck.Types +import GHC.HsToCore.Pmc.Types +import GHC.HsToCore.Pmc.Utils ( tracePm, mkPmId ) import GHC.Driver.Session import GHC.Driver.Config import GHC.Utils.Outputable -import GHC.Utils.Error +import GHC.Utils.Error ( pprErrMsgBagWithLoc ) import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.Bag -import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.DFM +import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) @@ -68,7 +74,6 @@ import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) 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 @@ -82,40 +87,32 @@ import Data.Foldable (foldlM, minimumBy, toList) import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) -import Data.Tuple (swap) - -import GHC.Driver.Ppr (pprTrace) --- Debugging Infrastructure - -tracePm :: String -> SDoc -> DsM () -tracePm herald doc = do - dflags <- getDynFlags - printer <- mkPrintUnqualifiedDs - liftIO $ dumpIfSet_dyn_printer printer dflags - Opt_D_dump_ec_trace "" FormatText (text herald $$ (nest 2 doc)) -{-# INLINE tracePm #-} -- see Note [INLINE conditional tracing utilities] +-- +-- * Main exports +-- -debugOn :: () -> Bool -debugOn _ = False --- debugOn _ = True +-- | Add a bunch of 'PhiCt's to all the 'Nabla's. +-- Lifts 'addPhiCts' over many 'Nablas'. +addPhiCtsNablas :: Nablas -> PhiCts -> DsM Nablas +addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas -trc :: String -> SDoc -> a -> a -trc | debugOn () = pprTrace - | otherwise = \_ _ a -> a +-- | 'addPmCtsNablas' for a single 'PmCt'. +addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas +addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) -_trcM :: Monad m => String -> SDoc -> m () -_trcM header doc = trc header doc (return ()) +liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas +liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) --- | Generate a fresh `Id` of a given type -mkPmId :: Type -> DsM Id -mkPmId ty = getUniqueM >>= \unique -> - let occname = mkVarOccFS $ fsLit "pm" - name = mkInternalName unique occname noSrcSpan - in return (mkLocalIdOrCoVar name Many ty) +-- | 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 <$> generateInhabitingPatterns 1 ds at . +isInhabited :: Nablas -> DsM Bool +isInhabited (MkNablas ds) = pure (not (null ds)) ----------------------------------------------- --- * Caching residual COMPLETE set +-- * Caching residual COMPLETE sets -- See Note [Implementation of COMPLETE pragmas] @@ -195,7 +192,7 @@ 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'), +*all* imported COMPLETE sets (in 'GHC.HsToCore.Pmc.Solver.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 @@ -496,7 +493,7 @@ emptyVarInfo x lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env x) +lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM 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 @@ -523,10 +520,7 @@ trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = set_vi <$> f (lookupVarInfo ts x) where set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env (vi_id vi') vi' } }) - ------------------------------------------------- --- * Exported utility functions querying 'Nabla' + (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) {- Note [Coverage checking Newtype matches] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -556,14 +550,14 @@ Handling of Newtypes is also described in the Appendix of the Lower Your Guards where you can find the solution in a perhaps more digestible format. -} -lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] +------------------------------------------------ +-- * Exported utility functions querying 'Nabla' + +lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt{ts_facts = (SDIE env)}) } k = - case lookupUDFM_Directly env (getUnique k) of - Nothing -> [] - Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) - Just (Entry vi) -> pmAltConSetElems (vi_neg vi) +lookupRefuts MkNabla{ nabla_tm_st = ts } x = + pmAltConSetElems $ vi_neg $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -720,7 +714,7 @@ addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do 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 = ts{ts_facts = setEntrySDIE env y vi' } } + pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". @@ -734,7 +728,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = setEntrySDIE env y vi' } } + $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -807,7 +801,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = setEntrySDIE env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -827,55 +821,27 @@ equateTys ts us = , not (eqType t u) ] --- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the +-- | Adds a @x ~ y@ constraint by merging the two 'VarInfo's and record the -- gained knowledge in 'Nabla'. -- --- 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. +-- Returns @Nothing@ when there's a contradiction while merging. 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 :: Nabla -> Id -> Id -> MaybeT DsM Nabla -addVarCt nabla at MkNabla{ nabla_tm_st = TmSt{ ts_facts = 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 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. --- Makes sure that the positive and negative facts of @x@ and @y@ are --- compatible. --- Preconditions: @not (sameRepresentativeSDIE env x y)@ --- --- See Note [TmState invariants]. -equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla -equate nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x y - = ASSERT( not (sameRepresentativeSDIE env x y) ) - case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env x y } }) - (_, Nothing) -> pure (nabla{ nabla_tm_st = ts{ ts_facts = setIndirectSDIE env y x } }) - -- 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... - -- We should decide how to break the tie - MASSERT2( idType (vi_id vi_x) `eqType` idType (vi_id vi_y), text "Not same type" ) - -- First assume that x and y are in the same equivalence class - let env_ind = setIndirectSDIE env x y - -- Then sum up the refinement counters - let env_refs = setEntrySDIE env_ind y vi_y - let nabla_refs = nabla{ nabla_tm_st = ts{ts_facts = env_refs} } - -- and then gradually merge every positive fact we have on x into y - let add_fact nabla (PACA 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 nabla nalt = addNotConCt nabla y nalt - nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_rcm will be updated in addNotConCt, so we are good to - -- go! - pure nabla_neg +addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = + case equateUSDFM env x y of + (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- Add the constraints we had for x to y + (Just vi_x, env') -> do + let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } + -- and then gradually merge every positive fact we have on x into y + let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args + nabla_pos <- foldlM add_pos nabla_equated (vi_pos vi_x) + -- Do the same for negative info + let add_neg nabla nalt = addNotConCt nabla y nalt + foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -943,7 +909,7 @@ addCoreCt nabla x e = do -- @x ~ y at . equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) + rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. modifyT (\nabla -> addVarCt nabla x rep) @@ -996,14 +962,14 @@ addCoreCt nabla x e = 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 :: Nabla -> CoreExpr -> DsM (Nabla, Id) +representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps e = pure (nabla, rep) + | Just rep <- lookupCoreMap reps e = pure (rep, nabla) | otherwise = do rep <- mkPmId (exprType e) let reps' = extendCoreMap reps e rep let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (nabla', rep) + pure (rep, nabla') -- | Like 'modify', but with an effectful modifier action modifyT :: Monad m => (s -> m s) -> StateT s m () @@ -1159,9 +1125,9 @@ Note [Strict fields and variables of unlifted type] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Binders of unlifted type (and strict fields) are unlifted by construction; they are conceived with an implicit @≁⊥@ constraint to begin with. Hence, -desugaring in "GHC.HsToCore.PmCheck" is entirely unconcerned by strict fields, +desugaring in "GHC.HsToCore.Pmc" is entirely unconcerned by strict fields, since the forcing happens *before* pattern matching. -And the φ constructor constraints emitted by 'GHC.HsToCore.PmCheck.checkGrd' +And the φ constructor constraints emitted by 'GHC.HsToCore.Pmc.checkGrd' have complex binding semantics (binding type constraints and unlifted fields), so unliftedness semantics are entirely confined to the oracle. @@ -1223,11 +1189,11 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = go [] env = pure ts{ts_facts=env} go (x:xs) !env = do vi' <- f (lookupVarInfo ts x) - go xs (setEntrySDIE env x vi') + go xs (addToUSDFM env x vi') traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseSDIE f env + env' <- traverseUSDFM f env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,43 +1,37 @@ -{- -Author: George Karachalias - Sebastian Graf --} - {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ApplicativeDo #-} --- | Types used through-out pattern match checking. This module is mostly there --- to be imported from "GHC.Tc.Types". The exposed API is that of --- "GHC.HsToCore.PmCheck.Oracle" and "GHC.HsToCore.PmCheck". -module GHC.HsToCore.PmCheck.Types ( - -- * Representations for Literals and AltCons - PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType, - isPmAltConMatchStrict, pmAltConImplBangs, +-- | Domain types used in "GHC.HsToCore.Pmc.Solver". +-- The ultimate goal is to define 'Nabla', which models normalised refinement +-- types from the paper +-- [Lower Your Guards: A Compositional Pattern-Match Coverage Checker"](https://dl.acm.org/doi/abs/10.1145/3408989). +module GHC.HsToCore.Pmc.Solver.Types ( - -- ** Equality on 'PmAltCon's - PmEquality(..), eqPmAltCon, - - -- ** Operations on 'PmLit' - literalToPmLit, negatePmLit, overloadPmLit, - pmLitAsStringLit, coreExprAsPmLit, + -- * Normalised refinement types + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + Nabla(..), Nablas(..), initNablas, - -- * Caching residual COMPLETE sets + -- ** Caching residual COMPLETE sets ConLikeSet, ResidualCompleteMatches(..), getRcm, isRcmInitialised, - -- * PmAltConSet + -- ** Representations for Literals and AltCons + PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType, + isPmAltConMatchStrict, pmAltConImplBangs, + + -- *** PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, extendPmAltConSet, pmAltConSetElems, - -- * A 'DIdEnv' where entries may be shared - Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE, - setIndirectSDIE, setEntrySDIE, traverseSDIE, entriesSDIE, + -- *** Equality on 'PmAltCon's + PmEquality(..), eqPmAltCon, + + -- *** Operations on 'PmLit' + literalToPmLit, negatePmLit, overloadPmLit, + pmLitAsStringLit, coreExprAsPmLit - -- * The pattern match oracle - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), - Nabla(..), Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -48,10 +42,9 @@ import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.DFM +import GHC.Types.Unique.SDFM import GHC.Types.Name import GHC.Core.DataCon import GHC.Core.ConLike @@ -76,6 +69,216 @@ import Data.Foldable (find) import Data.Ratio import qualified Data.Semigroup as Semi +-- +-- * Normalised refinement types +-- + +-- | 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 nabla that is always satisfiable +initNabla :: Nabla +initNabla = MkNabla initTyState initTmState + +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 (nabla_tm_st nabla), + ppr (nabla_ty_st nabla) + ] + +-- | A disjunctive bag of 'Nabla's, representing a refinement type. +newtype Nablas = MkNablas (Bag Nabla) + +initNablas :: Nablas +initNablas = MkNablas (unitBag initNabla) + +instance Outputable Nablas where + ppr (MkNablas nablas) = ppr nablas + +instance Semigroup Nablas where + MkNablas l <> MkNablas r = MkNablas (l `unionBags` r) + +instance Monoid Nablas where + mempty = MkNablas emptyBag + +-- | The type oracle state. An 'GHC.Tc.Solver.Monad.InertSet' that we +-- incrementally add local type constraints to, together with a sequence +-- number that counts the number of times we extended it with new facts. +data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } + +-- | Not user-facing. +instance Outputable TyState where + ppr (TySt n inert) = ppr n <+> ppr inert + +initTyState :: TyState +initTyState = TySt 0 emptyInert + +-- | 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. +-- +-- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". +data TmState + = TmSt + { ts_facts :: !(UniqSDFM Id VarInfo) + -- ^ Facts about term variables. Deterministic env, so that we generate + -- deterministic error messages. + , ts_reps :: !(CoreMap Id) + -- ^ An environment for looking up whether we already encountered semantically + -- equivalent expressions that we want to represent by the same 'Id' + -- representative. + , ts_dirty :: !DIdSet + -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new + -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). + } + +-- | 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 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). +-- +-- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.Pmc.Solver". +data VarInfo + = VI + { vi_id :: !Id + -- ^ The 'Id' in question. Important for adding new constraints relative to + -- this 'VarInfo' when we don't easily have the 'Id' available. + + , vi_pos :: ![PmAltConApp] + -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all + -- at the same time (i.e. conjunctive). We need a list because of nested + -- pattern matches involving pattern synonym + -- case x of { Just y -> case x of PatSyn z -> ... } + -- However, no more than one RealDataCon in the list, otherwise contradiction + -- because of generativity. + + , vi_neg :: !PmAltConSet + -- ^ Negative info: A list of 'PmAltCon's that it cannot match. + -- Example, assuming + -- + -- @ + -- data T = Leaf Int | Branch T T | Node Int T + -- @ + -- + -- then @x ≁ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, + -- and hence can only match @Branch at . Is orthogonal to anything from 'vi_pos', + -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing + -- between 'vi_pos' and 'vi_neg'. + + -- See Note [Why record both positive and negative info?] + -- It's worth having an actual set rather than a simple association list, + -- 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_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 + -- to recognise completion of a COMPLETE set efficiently for large enums. + } + +data PmAltConApp + = PACA + { paca_con :: !PmAltCon + , paca_tvs :: ![TyVar] + , paca_ids :: ![Id] + } + +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + +instance Outputable PmAltConApp where + ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = + hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) + +instance Outputable BotInfo where + ppr MaybeBot = underscore + ppr IsBot = text "~⊥" + ppr IsNotBot = text "≁⊥" + +-- | Not user-facing. +instance Outputable TmState where + ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + +-- | Not user-facing. +instance Outputable VarInfo where + ppr (VI x pos neg bot cache) + = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) + where + pp_x = ppr x <> dcolon <> ppr (idType x) + pp_pos + | [] <- pos = underscore + | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton + | otherwise = char '~' <> ppr pos + pp_neg + | isEmptyPmAltConSet neg = underscore + | otherwise = char '≁' <> ppr neg + pp_cache + | RCM Nothing Nothing <- cache = underscore + | otherwise = ppr cache + +-- | Initial state of the term oracle. +initTmState :: TmState +initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet + +-- | 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. + } + +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas + +isRcmInitialised :: ResidualCompleteMatches -> Bool +isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas + +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) + +-------------------------------------------------------------------------------- +-- The rest is just providing an IR for (overloaded!) literals and AltCons that +-- sits between Hs and Core. We need a reliable way to detect and determine +-- equality between them, which is impossible with Hs (too expressive) and with +-- Core (no notion of overloaded literals, and even plain 'Int' literals are +-- actually constructor apps). Also String literals are troublesome. + -- | Literals (simple and overloaded ones) for pattern match checking. -- -- See Note [Undecidable Equality for PmAltCons] @@ -230,7 +433,7 @@ 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". +-- See Note [Coverage checking Newtype matches] in "GHC.HsToCore.Pmc.Solver". isPmAltConMatchStrict :: PmAltCon -> Bool isPmAltConMatchStrict PmAltLit{} = True isPmAltConMatchStrict (PmAltConLike PatSynCon{}) = True -- #17357 @@ -288,7 +491,7 @@ The impact of this treatment of overloaded literals is the following: * We have instant equality check for overloaded literals (we do not rely on the term oracle which is rather expensive, both in terms of performance and memory). This significantly improves the performance of functions `covered` - `uncovered` and `divergent` in "GHC.HsToCore.PmCheck" and effectively addresses + `uncovered` and `divergent` in "GHC.HsToCore.Pmc" and effectively addresses #11161. * The warnings issued are simpler. @@ -347,23 +550,22 @@ coreExprAsPmLit e = case collectArgs e of -- overloaded lits anyway, so we immediately override type information -> literalToPmLit (exprType e) (mkLitDouble (litValue n % litValue d)) (Var x, args) - -- Take care of -XRebindableSyntax. The last argument should be the (only) - -- integer literal, otherwise we can't really do much about it. - | [Lit l] <- dropWhile (not . is_lit) args - , is_rebound_name x fromIntegerName + -- See Note [Detecting overloaded literals with -XRebindableSyntax] + | is_rebound_name x fromIntegerName + , [Lit l] <- dropWhile (not . is_lit) args -> literalToPmLit (literalType l) l >>= overloadPmLit (exprType e) (Var x, args) - -- Similar to fromInteger case - | [r] <- dropWhile (not . is_ratio) args - , is_rebound_name x fromRationalName + -- See Note [Detecting overloaded literals with -XRebindableSyntax] + | is_rebound_name x fromRationalName + , [r] <- dropWhile (not . is_ratio) args -> coreExprAsPmLit r >>= overloadPmLit (exprType e) (Var x, args) | is_rebound_name x fromStringName - -- With -XRebindableSyntax or without: The first String argument is what we are after + -- See Note [Detecting overloaded literals with -XRebindableSyntax] , s:_ <- filter (eqType stringTy . exprType) args -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings -> coreExprAsPmLit s >>= overloadPmLit (exprType e) - -- These last two cases handle String literals + -- These last two cases handle proper String literals (Var x, [Type ty]) | Just dc <- isDataConWorkId_maybe x , dc == nilDataCon @@ -383,11 +585,25 @@ coreExprAsPmLit e = case collectArgs e of | otherwise = False - -- | Compares the given Id to the Name based on OccName, to detect - -- -XRebindableSyntax. + -- See Note [Detecting overloaded literals with -XRebindableSyntax] is_rebound_name :: Id -> Name -> Bool is_rebound_name x n = getOccFS (idName x) == getOccFS n +{- Note [Detecting overloaded literals with -XRebindableSyntax] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Normally, we'd find e.g. overloaded string literals by comparing the +application head of an expression to `fromStringName`. But that doesn't work +with -XRebindableSyntax: The `Name` of a user-provided `fromString` function is +different to `fromStringName`, which lives in a certain module, etc. + +There really is no other way than to compare `OccName`s and guess which +argument is the actual literal string (we assume it's the first argument of +type `String`). + +The same applies to other overloaded literals, such as overloaded rationals +(`fromRational`)and overloaded integer literals (`fromInteger`). +-} + instance Outputable PmLitValue where ppr (PmLitInt i) = ppr i ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough @@ -420,271 +636,3 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show - --- | 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. - } - -getRcm :: ResidualCompleteMatches -> [ConLikeSet] -getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas - -isRcmInitialised :: ResidualCompleteMatches -> Bool -isRcmInitialised (RCM vanilla pragmas) = isJust vanilla && isJust pragmas - -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. -data Shared a - = Indirect Id - | Entry a - --- | A 'DIdEnv' in which entries can be shared by multiple 'Id's. --- Merge equivalence classes of two Ids by 'setIndirectSDIE' and set the entry --- of an Id with 'setEntrySDIE'. -newtype SharedDIdEnv a - = SDIE { unSDIE :: DIdEnv (Shared a) } - -emptySDIE :: SharedDIdEnv a -emptySDIE = SDIE emptyDVarEnv - -lookupReprAndEntrySDIE :: SharedDIdEnv a -> Id -> (Id, Maybe a) -lookupReprAndEntrySDIE sdie@(SDIE env) x = case lookupDVarEnv env x of - Nothing -> (x, Nothing) - Just (Indirect y) -> lookupReprAndEntrySDIE sdie y - Just (Entry a) -> (x, Just a) - --- | @lookupSDIE env x@ looks up an entry for @x@, looking through all --- 'Indirect's until it finds a shared 'Entry'. -lookupSDIE :: SharedDIdEnv a -> Id -> Maybe a -lookupSDIE sdie x = snd (lookupReprAndEntrySDIE sdie x) - --- | Check if two variables are part of the same equivalence class. -sameRepresentativeSDIE :: SharedDIdEnv a -> Id -> Id -> Bool -sameRepresentativeSDIE sdie x y = - fst (lookupReprAndEntrySDIE sdie x) == fst (lookupReprAndEntrySDIE sdie y) - --- | @setIndirectSDIE env x y@ sets @x@'s 'Entry' to @Indirect y@, thereby --- merging @x@'s equivalence class into @y@'s. This will discard all info on --- @x@! -setIndirectSDIE :: SharedDIdEnv a -> Id -> Id -> SharedDIdEnv a -setIndirectSDIE sdie@(SDIE env) x y = - SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Indirect y) - --- | @setEntrySDIE env x a@ sets the 'Entry' @x@ is associated with to @a@, --- thereby modifying its whole equivalence class. -setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a -setEntrySDIE sdie@(SDIE env) x a = - SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a) - -entriesSDIE :: SharedDIdEnv a -> [a] -entriesSDIE (SDIE env) = mapMaybe preview_entry (eltsUDFM env) - where - preview_entry (Entry e) = Just e - preview_entry _ = Nothing - -traverseSDIE :: forall a b f. Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b) -traverseSDIE f = fmap (SDIE . listToUDFM_Directly) . traverse g . udfmToList . unSDIE - where - g :: (Unique, Shared a) -> f (Unique, Shared b) - g (u, Indirect y) = pure (u,Indirect y) - g (u, Entry a) = do - a' <- f a - pure (u,Entry a') - -instance Outputable a => Outputable (Shared a) where - ppr (Indirect x) = ppr x - ppr (Entry a) = ppr a - -instance Outputable a => Outputable (SharedDIdEnv a) where - ppr (SDIE env) = ppr env - --- | 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. --- --- See Note [TmState invariants] in "GHC.HsToCore.PmCheck.Oracle". -data TmState - = TmSt - { ts_facts :: !(SharedDIdEnv VarInfo) - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. - , ts_dirty :: !DIdSet - -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new - -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). - } - --- | 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 'ResidualCompleteMatches' of a COMPLETE set --- ('vi_rcm'). --- --- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". -data VarInfo - = VI - { vi_id :: !Id - -- ^ The 'Id' in question. Important for adding new constraints relative to - -- this 'VarInfo' when we don't easily have the 'Id' available. - - , vi_pos :: ![PmAltConApp] - -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all - -- at the same time (i.e. conjunctive). We need a list because of nested - -- pattern matches involving pattern synonym - -- case x of { Just y -> case x of PatSyn z -> ... } - -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. - - , vi_neg :: !PmAltConSet - -- ^ Negative info: A list of 'PmAltCon's that it cannot match. - -- Example, assuming - -- - -- @ - -- data T = Leaf Int | Branch T T | Node Int T - -- @ - -- - -- then @x ≁ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@, - -- and hence can only match @Branch at . Is orthogonal to anything from 'vi_pos', - -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing - -- between 'vi_pos' and 'vi_neg'. - - -- See Note [Why record both positive and negative info?] - -- It's worth having an actual set rather than a simple association list, - -- 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_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 - -- to recognise completion of a COMPLETE set efficiently for large enums. - } - -data PmAltConApp - = PACA - { paca_con :: !PmAltCon - , paca_tvs :: ![TyVar] - , paca_ids :: ![Id] - } - --- | See 'vi_bot'. -data BotInfo - = IsBot - | IsNotBot - | MaybeBot - deriving Eq - -instance Outputable PmAltConApp where - ppr PACA{paca_con = con, paca_tvs = tvs, paca_ids = ids} = - hsep (ppr con : map ((char '@' <>) . ppr) tvs ++ map ppr ids) - -instance Outputable BotInfo where - ppr MaybeBot = underscore - ppr IsBot = text "~⊥" - ppr IsNotBot = text "≁⊥" - --- | Not user-facing. -instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty - --- | Not user-facing. -instance Outputable VarInfo where - ppr (VI x pos neg bot cache) - = braces (hcat (punctuate comma [pp_x, pp_pos, pp_neg, ppr bot, pp_cache])) - where - pp_x = ppr x <> dcolon <> ppr (idType x) - pp_pos - | [] <- pos = underscore - | [p] <- pos = char '~' <> ppr p -- suppress outer [_] if singleton - | otherwise = char '~' <> ppr pos - pp_neg - | isEmptyPmAltConSet neg = underscore - | otherwise = char '≁' <> ppr neg - pp_cache - | RCM Nothing Nothing <- cache = underscore - | otherwise = ppr cache - --- | Initial state of the term oracle. -initTmState :: TmState -initTmState = TmSt emptySDIE emptyCoreMap emptyDVarSet - --- | The type oracle state. An 'GHC.Tc.Solver.Monad.InsertSet' that we --- incrementally add local type constraints to, together with a sequence --- number that counts the number of times we extended it with new facts. -data TyState = TySt { ty_st_n :: !Int, ty_st_inert :: !InertSet } - --- | Not user-facing. -instance Outputable TyState where - ppr (TySt n inert) = ppr n <+> ppr inert - -initTyState :: TyState -initTyState = TySt 0 emptyInert - --- | 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 nabla that is always satisfiable -initNabla :: Nabla -initNabla = MkNabla initTyState initTmState - -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 (nabla_tm_st nabla), - ppr (nabla_ty_st nabla) - ] - --- | A disjunctive bag of 'Nabla's, representing a refinement type. -newtype Nablas = MkNablas (Bag Nabla) - -initNablas :: Nablas -initNablas = MkNablas (unitBag initNabla) - -instance Outputable Nablas where - ppr (MkNablas nablas) = ppr nablas - -instance Semigroup Nablas where - MkNablas l <> MkNablas r = MkNablas (l `unionBags` r) - -instance Monoid Nablas where - mempty = MkNablas emptyBag - -liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas -liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -0,0 +1,231 @@ +{- +Author: George Karachalias + Sebastian Graf +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveFunctor #-} + +-- | Types used through-out pattern match checking. This module is mostly there +-- to be imported from "GHC.HsToCore.Types". The exposed API is that of +-- "GHC.HsToCore.Pmc". +-- +-- These types model the paper +-- [Lower Your Guards: A Compositional Pattern-Match Coverage Checker"](https://dl.acm.org/doi/abs/10.1145/3408989). +module GHC.HsToCore.Pmc.Types ( + -- * LYG syntax + + -- ** Guard language + SrcInfo(..), PmGrd(..), GrdVec(..), + + -- ** Guard tree language + PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + + -- * Coverage Checking types + RedSets (..), Precision (..), CheckResult (..), + + -- * Pre and post coverage checking synonyms + Pre, Post, + + -- * Normalised refinement types + module GHC.HsToCore.Pmc.Solver.Types + + ) where + +#include "HsVersions.h" + +import GHC.Prelude + +import GHC.HsToCore.Pmc.Solver.Types + +import GHC.Data.OrdList +import GHC.Types.Id +import GHC.Types.Var (EvVar) +import GHC.Types.SrcLoc +import GHC.Utils.Outputable +import GHC.Core.Type +import GHC.Core + +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import qualified Data.Semigroup as Semi + +-- +-- * Guard language +-- + +-- | A very simple language for pattern guards. Let bindings, bang patterns, +-- and matching variables against flat constructor patterns. +-- The LYG guard language. +data PmGrd + = -- | @PmCon x K dicts args@ corresponds to a @K dicts args <- x@ guard. + -- The @args@ are bound in this construct, the @x@ is just a use. + -- For the arguments' meaning see 'GHC.Hs.Pat.ConPatOut'. + PmCon { + pm_id :: !Id, + pm_con_con :: !PmAltCon, + pm_con_tvs :: ![TyVar], + pm_con_dicts :: ![EvVar], + pm_con_args :: ![Id] + } + + -- | @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] in GHC.HsToCore.Pmc.Check. + | PmBang { + pm_id :: !Id, + _pm_loc :: !(Maybe SrcInfo) + } + + -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually + -- /binds/ @x at . + | PmLet { + pm_id :: !Id, + _pm_let_expr :: !CoreExpr + } + +-- | Should not be user-facing. +instance Outputable PmGrd where + ppr (PmCon x alt _tvs _con_dicts con_args) + = hsep [ppr alt, hsep (map ppr con_args), text "<-", ppr x] + ppr (PmBang x _loc) = char '!' <> ppr x + ppr (PmLet x expr) = hsep [text "let", ppr x, text "=", ppr expr] + +-- +-- * 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. +newtype SrcInfo = SrcInfo (Located SDoc) + +-- | A sequence of 'PmGrd's. +newtype GrdVec = GrdVec [PmGrd] + +-- | 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) + +instance Outputable SrcInfo where + ppr (SrcInfo (L (RealSrcSpan rss _) _)) = ppr (srcSpanStartLine rss) + ppr (SrcInfo (L s _)) = ppr s + +-- | Format LYG guards as @| True <- x, let x = 42, !z@ +instance Outputable GrdVec where + ppr (GrdVec []) = empty + ppr (GrdVec (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 p => Outputable (PmMatchGroup p) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable p => Outputable (PmMatch p) where + ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + ppr grds <+> ppr grhss + +instance Outputable p => Outputable (PmGRHS p) where + ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = + ppr grds <+> text "->" <+> ppr rhs + +instance Outputable p => Outputable (PmPatBind p) where + ppr (PmPatBind PmGRHS { pg_grds = grds, pg_rhs = bind }) = + ppr bind <+> ppr grds <+> text "=" <+> text "..." + +instance Outputable PmEmptyCase where + ppr (PmEmptyCase { pe_var = var }) = + text " ppr var <> text ">" + +data Precision = Approximate | Precise + deriving (Eq, Show) + +instance Outputable Precision where + ppr = text . show + +instance Semi.Semigroup Precision where + Precise <> Precise = Precise + _ <> _ = Approximate + +instance Monoid Precision where + mempty = Precise + mappend = (Semi.<>) + +-- | Redundancy sets, used to determine redundancy of RHSs and bang patterns +-- (later digested into a 'CIRB'). +data RedSets + = RedSets + { rs_cov :: !Nablas + -- ^ The /Covered/ set; the set of values reaching a particular program + -- point. + , 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 (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]. + } + +instance Outputable RedSets where + ppr RedSets { rs_cov = _cov, rs_div = _div, rs_bangs = _bangs } + -- It's useful to change this definition for different verbosity levels in + -- printf-debugging + = empty + +-- | Pattern-match coverage check result +data CheckResult a + = CheckResult + { cr_ret :: !a + -- ^ A hole for redundancy info and covered sets. + , 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 + -- ^ 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 + +-- +-- * Pre and post coverage checking synonyms +-- + +-- | Used as tree payload pre-checking. The LYG guards to check. +type Pre = GrdVec + +-- | Used as tree payload post-checking. The redundancy info we elaborated. +type Post = RedSets ===================================== compiler/GHC/HsToCore/Pmc/Utils.hs ===================================== @@ -0,0 +1,140 @@ +{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, + MultiWayIf, ScopedTypeVariables, MagicHash #-} + +-- | Utility module for the pattern-match coverage checker. +module GHC.HsToCore.Pmc.Utils ( + + tracePm, mkPmId, + allPmCheckWarnings, overlapping, exhaustive, redundantBang, + exhaustiveWarningFlag, + isMatchContextPmChecked, needToRunPmCheck + + ) where + +#include "HsVersions.h" + +import GHC.Prelude + +import GHC.Types.Basic (Origin(..), isGenerated) +import GHC.Driver.Session +import GHC.Hs +import GHC.Core.Type +import GHC.Data.FastString +import GHC.Data.IOEnv +import GHC.Types.Id +import GHC.Types.Name +import GHC.Types.Unique.Supply +import GHC.Types.SrcLoc +import GHC.Utils.Error +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.HsToCore.Monad + +tracePm :: String -> SDoc -> DsM () +tracePm herald doc = do + dflags <- getDynFlags + printer <- mkPrintUnqualifiedDs + liftIO $ dumpIfSet_dyn_printer printer dflags + Opt_D_dump_ec_trace "" FormatText (text herald $$ (nest 2 doc)) +{-# INLINE tracePm #-} -- see Note [INLINE conditional tracing utilities] + +-- | Generate a fresh `Id` of a given type +mkPmId :: Type -> DsM Id +mkPmId ty = getUniqueM >>= \unique -> + let occname = mkVarOccFS $ fsLit "pm" + name = mkInternalName unique occname noSrcSpan + in return (mkLocalIdOrCoVar name Many ty) + +-- | All warning flags that need to run the pattern match checker. +allPmCheckWarnings :: [WarningFlag] +allPmCheckWarnings = + [ Opt_WarnIncompletePatterns + , Opt_WarnIncompleteUniPatterns + , Opt_WarnIncompletePatternsRecUpd + , Opt_WarnOverlappingPatterns + ] + +-- | Check whether the redundancy checker should run (redundancy only) +overlapping :: DynFlags -> HsMatchContext id -> Bool +-- See Note [Inaccessible warnings for record updates] +overlapping _ RecUpd = False +overlapping dflags _ = wopt Opt_WarnOverlappingPatterns dflags + +-- | Check whether the exhaustiveness checker should run (exhaustiveness only) +exhaustive :: DynFlags -> HsMatchContext id -> Bool +exhaustive dflags = maybe False (`wopt` dflags) . exhaustiveWarningFlag + +-- | Check whether unnecessary bangs should be warned about +redundantBang :: DynFlags -> Bool +redundantBang dflags = wopt Opt_WarnRedundantBangPatterns dflags + +-- | Denotes whether an exhaustiveness check is supported, and if so, +-- via which 'WarningFlag' it's controlled. +-- Returns 'Nothing' if check is not supported. +exhaustiveWarningFlag :: HsMatchContext id -> Maybe WarningFlag +exhaustiveWarningFlag (FunRhs {}) = Just Opt_WarnIncompletePatterns +exhaustiveWarningFlag CaseAlt = Just Opt_WarnIncompletePatterns +exhaustiveWarningFlag IfAlt = Just Opt_WarnIncompletePatterns +exhaustiveWarningFlag LambdaExpr = Just Opt_WarnIncompleteUniPatterns +exhaustiveWarningFlag PatBindRhs = Just Opt_WarnIncompleteUniPatterns +exhaustiveWarningFlag PatBindGuards = Just Opt_WarnIncompletePatterns +exhaustiveWarningFlag ProcExpr = Just Opt_WarnIncompleteUniPatterns +exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd +exhaustiveWarningFlag ThPatSplice = Nothing +exhaustiveWarningFlag PatSyn = Nothing +exhaustiveWarningFlag ThPatQuote = Nothing +-- Don't warn about incomplete patterns in list comprehensions, pattern guards +-- etc. They are often *supposed* to be incomplete +exhaustiveWarningFlag (StmtCtxt {}) = Nothing + +-- | 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 + +-- | 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. +-} ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) -import GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.HsToCore.Pmc.Types (Nablas) import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error @@ -61,7 +61,7 @@ data 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". + -- ^ See Note [Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -820,7 +820,7 @@ It does *not* reduce type or data family applications or look through newtypes. Why is this useful? As one example, when coverage-checking an EmptyCase 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". +in Note [Type normalisation] in "GHC.HsToCore.Pmc". To accomplish its stated goal, tcNormalise first initialises the solver monad with the given InertCans, then uses flattenType to simplify the desired type ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -0,0 +1,121 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ApplicativeDo #-} +{-# OPTIONS_GHC -Wall #-} + +-- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the +-- same entry. See 'UniqSDFM'. +module GHC.Types.Unique.SDFM ( + -- * Unique-keyed, /shared/, deterministic mappings + UniqSDFM, + + emptyUSDFM, + lookupUSDFM, + equateUSDFM, addToUSDFM, + traverseUSDFM + ) where + +import GHC.Prelude + +import GHC.Types.Unique +import GHC.Types.Unique.DFM +import GHC.Utils.Outputable + +-- | Either @Indirect x@, meaning the value is represented by that of @x@, or +-- an @Entry@ containing containing the actual value it represents. +data Shared key ele + = Indirect !key + | Entry !ele + +-- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a +-- common value of type @ele at . +-- Every such set (\"equivalence class\") has a distinct representative +-- 'Unique'. Supports merging the entries of multiple such sets in a union-find +-- like fashion. +-- +-- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from +-- sets of @key at s to possibly absent entries @ele@, where the sets don't overlap. +-- Example: +-- @ +-- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)] +-- @ +-- On this model we support the following main operations: +-- +-- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@, +-- @'lookupUSDFM' m u5 == Nothing at . +-- * @'equateUSDFM' m u1 u3@ is a no-op, but +-- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to +-- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1 at . +-- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4 at . +-- +-- As well as a few means for traversal/conversion to list. +newtype UniqSDFM key ele + = USDFM { unUSDFM :: UniqDFM key (Shared key ele) } + +emptyUSDFM :: UniqSDFM key ele +emptyUSDFM = USDFM emptyUDFM + +lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele) +lookupReprAndEntryUSDFM (USDFM env) = go + where + go x = case lookupUDFM env x of + Nothing -> (x, Nothing) + Just (Indirect y) -> go y + Just (Entry ele) -> (x, Just ele) + +-- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all +-- 'Indirect's until it finds a shared 'Entry'. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1 +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing +-- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing +lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele +lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) + +-- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry, +-- thereby merging @x@'s class with @y@'s. +-- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be +-- chosen as the new entry and @x@'s old entry will be returned. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) +-- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +equateUSDFM + :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) +equateUSDFM usdfm@(USDFM env) x y = + case (lu x, lu y) of + ((x', _) , (y', _)) + | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do + ((x', _) , (_ , Nothing)) -> (Nothing, set_indirect y x') + ((_ , mb_ex), (y', _)) -> (mb_ex, set_indirect x y') + where + lu = lookupReprAndEntryUSDFM usdfm + set_indirect a b = USDFM $ addToUDFM env a (Indirect b) + +-- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@, +-- thereby modifying its whole equivalence class. +-- +-- Examples in terms of the model (see 'UniqSDFM'): +-- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)] +-- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)] +addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele +addToUSDFM usdfm@(USDFM env) x v = + USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v) + +traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b) +traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM + where + g :: (Unique, Shared key a) -> f (Unique, Shared key b) + g (u, Indirect y) = pure (u,Indirect y) + g (u, Entry a) = do + a' <- f a + pure (u,Entry a') + +instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where + ppr (Indirect x) = ppr x + ppr (Entry a) = ppr a + +instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where + ppr (USDFM env) = ppr env ===================================== compiler/ghc.cabal.in ===================================== @@ -307,10 +307,14 @@ Library GHC.Core.Stats GHC.Core.Make GHC.Core.Ppr - GHC.HsToCore.PmCheck.Oracle - GHC.HsToCore.PmCheck.Ppr - GHC.HsToCore.PmCheck.Types - GHC.HsToCore.PmCheck + GHC.HsToCore.Pmc + GHC.HsToCore.Pmc.Types + GHC.HsToCore.Pmc.Utils + GHC.HsToCore.Pmc.Desugar + GHC.HsToCore.Pmc.Check + GHC.HsToCore.Pmc.Solver.Types + GHC.HsToCore.Pmc.Solver + GHC.HsToCore.Pmc.Ppr GHC.HsToCore.Coverage GHC.HsToCore GHC.HsToCore.Types @@ -565,6 +569,7 @@ Library GHC.Data.Stream GHC.Data.StringBuffer GHC.Types.Unique.DFM + GHC.Types.Unique.SDFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Set View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83407ffc7acc00cc025b9f6ed063add9ab9f9bcc...f08f98e821bc4b755a7b6ad3bad39ce1099c5405 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/83407ffc7acc00cc025b9f6ed063add9ab9f9bcc...f08f98e821bc4b755a7b6ad3bad39ce1099c5405 You're receiving 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 26 09:37:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 05:37:30 -0400 Subject: [Git][ghc/ghc][master] Bignum: add bigNatFromWordArray Message-ID: <5f6f0bda648c4_80b3f84903eed2014717875@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 2 changed files: - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs ===================================== @@ -1520,3 +1520,42 @@ bigNatFromByteArrayBE# sz ba moff s = bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat# #) bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s + + + + +-- | Create a BigNat# from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray# :: WordArray# -> Word# -> BigNat# +bigNatFromWordArray# wa n0 + | isTrue# (n `eqWord#` 0##) + = bigNatZero# (# #) + + | isTrue# (r `eqWord#` 0##) -- i.e. wa is multiple of limb-size + , isTrue# (q `eqWord#` n) + = wa + + | True = withNewWordArray# (word2Int# n) \mwa s -> + mwaArrayCopy# mwa 0# wa 0# (word2Int# n) s + where + !(# q, r #) = quotRemWord# (int2Word# (sizeofByteArray# wa)) + WORD_SIZE_IN_BYTES## + -- find real size in Words by removing trailing null limbs + !n = real_size n0 + real_size 0## = 0## + real_size i + | 0## <- bigNatIndex# wa (word2Int# (i `minusWord#` 1##)) + = real_size (i `minusWord#` 1##) + real_size i = i + + +-- | Create a BigNat from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray :: WordArray# -> Word# -> BigNat +bigNatFromWordArray wa n = BN# (bigNatFromWordArray# wa n) ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Integer.GMP.Internals -- ** Conversions to/from 'BigNat' + , byteArrayToBigNat# , wordToBigNat , wordToBigNat2 , bigNatToInt @@ -432,3 +433,8 @@ importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArra 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 #)) + + +{-# DEPRECATED byteArrayToBigNat# "Use bigNatFromWordArray instead" #-} +byteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat +byteArrayToBigNat# ba n = B.bigNatFromWordArray ba (int2Word# n) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cde295c543e209c3b81256b50e77f3c5132a4ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1cde295c543e209c3b81256b50e77f3c5132a4ad You're receiving 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 26 10:08:23 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 06:08:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: PmCheck: Big refactor of module structure Message-ID: <5f6f13172d495_80b3f8468c57034147321a3@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 86de75f6 by Krzysztof Gogolewski at 2020-09-26T06:08:08-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 88ab84a8 by Krzysztof Gogolewski at 2020-09-26T06:08:14-04:00 Disallow linear types in FFI (#18472) - - - - - 4149828c by Krzysztof Gogolewski at 2020-09-26T06:08:15-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 26 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Hs/Extension.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/HsToCore/Pmc/Types.hs - + compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Solver.hs - + compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - + testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T - + testsuite/tests/linear/should_fail/LinearFFI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/147f1e6a503304a367de1dc9ed68d6ab6556c943...4149828c2935eed35dfdd27c128836adcaf89fae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/147f1e6a503304a367de1dc9ed68d6ab6556c943...4149828c2935eed35dfdd27c128836adcaf89fae You're receiving 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 26 11:36:51 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sat, 26 Sep 2020 07:36:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18501 Message-ID: <5f6f27d39becd_80b3f8443a679d8147446f4@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18501 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18501 You're receiving 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 26 12:56:33 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 26 Sep 2020 08:56:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tuple-width Message-ID: <5f6f3a81eb7a2_80b8e6962014768161@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/tuple-width at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tuple-width You're receiving 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 26 12:58:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 26 Sep 2020 08:58:00 -0400 Subject: [Git][ghc/ghc][wip/tuple-width] 69 commits: Introduce OutputableP Message-ID: <5f6f3ad8a0356_80b3f84866e102814769763@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/tuple-width at Glasgow Haskell Compiler / GHC Commits: ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 88c62a71 by GHC GitLab CI at 2020-09-26T12:57:49+00:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1663e3ea72b7efbd54034f5112e5eecc7345a63...88c62a711734eed52747bc4744e4dc3974aa4564 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1663e3ea72b7efbd54034f5112e5eecc7345a63...88c62a711734eed52747bc4744e4dc3974aa4564 You're receiving 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 26 17:18:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 13:18:29 -0400 Subject: [Git][ghc/ghc][master] Make 'undefined x' linear in 'x' (#18731) Message-ID: <5f6f77e5443d4_80b3f84670f44b81482137@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - + testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Tc.Gen.App import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC ) +import GHC.Builtin.Types (multiplicityTy) import GHC.Tc.Gen.Head import GHC.Hs import GHC.Tc.Utils.Monad @@ -499,13 +500,17 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args -- - We need the freshly allocated unification variables, to extend -- delta with. -- It's easier just to do the job directly here. - do { arg_nus <- replicateM (countLeadingValArgs args) newOpenFlexiTyVar + do { let valArgsCount = countLeadingValArgs args + ; arg_nus <- replicateM valArgsCount newOpenFlexiTyVar + -- We need variables for multiplicity (#18731) + -- Otherwise, 'undefined x' wouldn't be linear in x + ; mults <- replicateM valArgsCount (newFlexiTyVarTy multiplicityTy) ; res_nu <- newOpenFlexiTyVar ; kind_co <- unifyKind Nothing liftedTypeKind (tyVarKind kappa) ; let delta' = delta `extendVarSetList` (res_nu:arg_nus) arg_tys = mkTyVarTys arg_nus res_ty = mkTyVarTy res_nu - fun_ty' = mkVisFunTysMany arg_tys res_ty + fun_ty' = mkVisFunTys (zipWithEqual "tcInstFun" mkScaled mults arg_tys) res_ty co_wrap = mkWpCastN (mkTcGReflLeftCo Nominal fun_ty' kind_co) acc' = addArgWrap co_wrap acc -- Suppose kappa :: kk ===================================== testsuite/tests/linear/should_compile/T18731.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE LinearTypes #-} +module T18731 where + +f :: a #-> b +f x = undefined x ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -36,3 +36,4 @@ test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) test('LinearHole', normal, compile, ['']) +test('T18731', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bda55fa0444310079ab89f2d28ddb8982975b646 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bda55fa0444310079ab89f2d28ddb8982975b646 You're receiving 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 26 17:19:07 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 13:19:07 -0400 Subject: [Git][ghc/ghc][master] Disallow linear types in FFI (#18472) Message-ID: <5f6f780b344e1_80b8cc632c14824089@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - 4 changed files: - compiler/GHC/Tc/Gen/Foreign.hs - + testsuite/tests/linear/should_fail/LinearFFI.hs - + testsuite/tests/linear/should_fail/LinearFFI.stderr - testsuite/tests/linear/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -243,7 +243,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty -- things are LocalIds. However, it does not need zonking, -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it). - ; imp_decl' <- tcCheckFIType (map scaledThing arg_tys) res_ty imp_decl + ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl -- Can't use sig_ty here because sig_ty :: Type and -- we need HsType Id hence the undefined ; let fi_decl = ForeignImport { fd_name = L nloc id @@ -255,14 +255,14 @@ tcFImport d = pprPanic "tcFImport" (ppr d) -- ------------ Checking types for foreign import ---------------------- -tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport +tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src) -- Foreign import label = do checkCg checkCOrAsmOrLlvmOrInterp -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) - check (isFFILabelTy (mkVisFunTysMany arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) + check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) cconv' <- checkCConv cconv return (CImport (L lc cconv') safety mh l src) @@ -274,7 +274,9 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of - [arg1_ty] -> do checkForeignArgs isFFIExternalTy (map scaledThing arg1_tys) + [Scaled arg1_mult arg1_ty] -> do + checkNoLinearFFI arg1_mult + checkForeignArgs isFFIExternalTy arg1_tys checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty where @@ -290,9 +292,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh case arg_tys of -- The first arg must be Ptr or FunPtr [] -> addErrTc (illegalForeignTyErr Outputable.empty (text "At least one argument expected")) - (arg1_ty:arg_tys) -> do + (Scaled arg1_mult arg1_ty:arg_tys) -> do dflags <- getDynFlags - let curried_res_ty = mkVisFunTysMany arg_tys res_ty + let curried_res_ty = mkVisFunTys arg_tys res_ty + checkNoLinearFFI arg1_mult check (isFFIDynTy curried_res_ty arg1_ty) (illegalForeignTyErr argument) checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys @@ -317,7 +320,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh dflags <- getDynFlags checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty - checkMissingAmpersand dflags arg_tys res_ty + checkMissingAmpersand dflags (map scaledThing arg_tys) res_ty case target of StaticTarget _ _ _ False | not (null arg_tys) -> @@ -405,7 +408,7 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkCg checkCOrAsmOrLlvm checkTc (isCLabelString str) (badCName str) cconv' <- checkCConv cconv - checkForeignArgs isFFIExternalTy (map scaledThing arg_tys) + checkForeignArgs isFFIExternalTy arg_tys checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where @@ -422,10 +425,16 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do -} ------------ Checking argument types for foreign import ---------------------- -checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM () +checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM () checkForeignArgs pred tys = mapM_ go tys where - go ty = check (pred ty) (illegalForeignTyErr argument) + go (Scaled mult ty) = checkNoLinearFFI mult >> + check (pred ty) (illegalForeignTyErr argument) + +checkNoLinearFFI :: Mult -> TcM () -- No linear types in FFI (#18472) +checkNoLinearFFI Many = return () +checkNoLinearFFI _ = addErrTc $ illegalForeignTyErr argument + (text "Linear types are not supported in FFI declarations, see #18472") ------------ Checking result types for foreign calls ---------------------- -- | Check that the type has the form ===================================== testsuite/tests/linear/should_fail/LinearFFI.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes #-} +module LinearFFI where -- #18472 + +import Foreign.Ptr + +foreign import ccall "exp" c_exp :: Double #-> Double +foreign import stdcall "dynamic" d8 :: FunPtr (IO Int) #-> IO Int +foreign import ccall "wrapper" mkF :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/LinearFFI.stderr ===================================== @@ -0,0 +1,20 @@ + +LinearFFI.hs:6:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "exp" c_exp :: Double #-> Double + +LinearFFI.hs:7:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import stdcall safe "dynamic" d8 + :: FunPtr (IO Int) #-> IO Int + +LinearFFI.hs:8:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "wrapper" mkF + :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -28,3 +28,4 @@ test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) test('LinearPatternGuardWildcard', normal, compile_fail, ['']) +test('LinearFFI', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/160fba4aa306c0649c72a6dcd7c98d9782a0e74b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/160fba4aa306c0649c72a6dcd7c98d9782a0e74b You're receiving 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 26 17:19:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 26 Sep 2020 13:19:43 -0400 Subject: [Git][ghc/ghc][master] Fix handling of function coercions (#18747) Message-ID: <5f6f782febe86_80b3f84962ea1f8148267b6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 4 changed files: - compiler/GHC/Core/Coercion.hs - + testsuite/tests/simplCore/should_compile/T18747A.hs - + testsuite/tests/simplCore/should_compile/T18747B.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1486,7 +1486,7 @@ instCoercion (Pair lty rty) g w | isFunTy lty && isFunTy rty -- g :: (t1 -> t2) ~ (t3 -> t4) -- returns t2 ~ t4 - = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->) + = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->) | otherwise -- one forall, one funty... = Nothing ===================================== testsuite/tests/simplCore/should_compile/T18747A.hs ===================================== @@ -0,0 +1,82 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T18747A where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type +data SomeSing :: Type -> Type where + SomeSing :: Sing (a :: k) -> SomeSing k + +data SList :: forall a. [a] -> Type where + SNil :: SList '[] + SCons :: Sing x -> Sing xs -> SList (x:xs) +type instance Sing = SList + +data Univ = U1 | K1 Type | Sum Univ Univ | Product Univ Univ + +data SUniv :: Univ -> Type where + SU1 :: SUniv U1 + SK1 :: Sing c -> SUniv (K1 c) + SSum :: Sing a -> Sing b -> SUniv (Sum a b) + SProduct :: Sing a -> Sing b -> SUniv (Product a b) +type instance Sing = SUniv + +data In :: Univ -> Type where + MkU1 :: In U1 + MkK1 :: c -> In (K1 c) + L1 :: In a -> In (Sum a b) + R1 :: In b -> In (Sum a b) + MkProduct :: In a -> In b -> In (Product a b) + +data SIn :: forall u. In u -> Type where + SMkU1 :: SIn MkU1 + SMkK1 :: Sing c -> SIn (MkK1 c) + SL1 :: Sing a -> SIn (L1 a) + SR1 :: Sing b -> SIn (R1 b) + SMkProduct :: Sing a -> Sing b -> SIn (MkProduct a b) +type instance Sing = SIn + +class Generic (a :: Type) where + type Rep a :: Univ + from :: a -> In (Rep a) + to :: In (Rep a) -> a + +class PGeneric (a :: Type) where + type PFrom (x :: a) :: In (Rep a) + type PTo (x :: In (Rep a)) :: a + +class SGeneric k where + sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) + sTo :: forall (a :: In (Rep k)). Sing a -> Sing (PTo a :: k) + sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a + sFot :: forall (a :: In (Rep k)). Sing a -> PFrom (PTo a :: k) :~: a + +instance Generic [a] where + type Rep [a] = Sum U1 (Product (K1 a) (K1 [a])) + from [] = L1 MkU1 + from (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + to (L1 MkU1) = [] + to (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance PGeneric [a] where + type PFrom '[] = L1 MkU1 + type PFrom (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + type PTo (L1 MkU1) = '[] + type PTo (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance SGeneric [a] where + sFrom SNil = SL1 SMkU1 + sFrom (SCons x xs) = SR1 (SMkProduct (SMkK1 x) (SMkK1 xs)) + sTo (SL1 SMkU1) = SNil + sTo (SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))) = SCons x xs + sTof SNil = Refl + sTof SCons{} = Refl + sFot (SL1 SMkU1) = Refl + sFot (SR1 (SMkProduct SMkK1{} SMkK1{})) = Refl ===================================== testsuite/tests/simplCore/should_compile/T18747B.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T18747B where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type + +data SomeSing (k :: Type) where + SomeSing :: Sing (a :: k) -> SomeSing k + +type family Promote (k :: Type) :: Type +type family PromoteX (a :: k) :: Promote k + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +type SingKindX (a :: k) = (PromoteX (DemoteX a) ~~ a) + +class SingKindX k => SingKind k where + toSing :: Demote k -> SomeSing k + +type instance Demote Type = Type +type instance Promote Type = Type +type instance DemoteX (a :: Type) = Demote a +type instance PromoteX (a :: Type) = Promote a + +type instance Demote Bool = Bool +type instance Promote Bool = Bool + +data Foo (a :: Type) where MkFoo :: Foo Bool + +data SFoo :: forall a. Foo a -> Type where + SMkFoo :: SFoo MkFoo +type instance Sing = SFoo + +type instance Demote (Foo a) = Foo (DemoteX a) +type instance Promote (Foo a) = Foo (PromoteX a) + +instance SingKindX a => SingKind (Foo a) where + toSing MkFoo = SomeSing SMkFoo + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -338,3 +338,5 @@ test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) +test('T18747A', normal, compile, ['']) +test('T18747B', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e124f2a7d9a5932a4c2383fd3f9dd772b2059885 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e124f2a7d9a5932a4c2383fd3f9dd772b2059885 You're receiving 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 26 18:03:15 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 14:03:15 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 64 commits: rts/nonmoving: Add missing STM write barrier Message-ID: <5f6f826349737_80b3f83d02f335014843578@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 4779d0ea by Vladislav Zavialov at 2020-09-26T21:03:03+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 25 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fe83f2d364c69ab4c9c88baaeb1a961d6ffa9a8...4779d0ea5be60e271715d0b302b16039729eb425 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9fe83f2d364c69ab4c9c88baaeb1a961d6ffa9a8...4779d0ea5be60e271715d0b302b16039729eb425 You're receiving 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 26 18:50:00 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 14:50:00 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 4 commits: Make 'undefined x' linear in 'x' (#18731) Message-ID: <5f6f8d58dd134_80b3f846760d0f81486777d@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 8dbaa00e by Vladislav Zavialov at 2020-09-26T21:49:52+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4779d0ea5be60e271715d0b302b16039729eb425...8dbaa00e640c2d9f1ab274d44640f1d193895fd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4779d0ea5be60e271715d0b302b16039729eb425...8dbaa00e640c2d9f1ab274d44640f1d193895fd0 You're receiving 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 26 19:33:07 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Sat, 26 Sep 2020 15:33:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18753 Message-ID: <5f6f9773cade5_80b3f8434baac3c14876514@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/T18753 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18753 You're receiving 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 26 20:39:33 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Sat, 26 Sep 2020 16:39:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/cfuneqcan-refactor Message-ID: <5f6fa705a341f_80b3f8458345c08148833aa@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/cfuneqcan-refactor You're receiving 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 26 22:28:18 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 18:28:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/no-arrow-rearrangement Message-ID: <5f6fc082e6906_80bf533bbc14890318@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/no-arrow-rearrangement at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-arrow-rearrangement You're receiving 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 26 22:30:02 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 18:30:02 -0400 Subject: [Git][ghc/ghc][wip/no-arrow-rearrangement] Don't rearrange (->) in the renamer Message-ID: <5f6fc0ea87f40_80b3f848d157b28148905c1@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/no-arrow-rearrangement at Glasgow Haskell Compiler / GHC Commits: 954ec03f by Vladislav Zavialov at 2020-09-27T01:29:36+03:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible fixity 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - 1 changed file: - compiler/GHC/Rename/HsType.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -52,14 +52,13 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names -import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity +import GHC.Types.Basic ( compareFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) import GHC.Utils.Outputable @@ -600,8 +599,7 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) - (unLoc l_op') fix ty1' ty2' + ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) @@ -632,12 +630,9 @@ rnHsTyKi env (HsFunTy _ mult ty1 ty2) -- Or as the result. This happens when reading Prelude.hi -- when we find return :: forall m. Monad m -> forall a. a -> m a - -- Check for fixity rearrangements ; (mult', w_fvs) <- rnHsArrow env mult - ; res_ty <- mkHsOpTyRn (hs_fun_ty mult') funTyConName funTyFixity ty1' ty2' - ; return (res_ty, fvs1 `plusFV` fvs2 `plusFV` w_fvs) } - where - hs_fun_ty w a b = HsFunTy noExtField w a b + ; return (HsFunTy noExtField mult' ty1' ty2' + , plusFVs [fvs1, fvs2, w_fvs]) } rnHsTyKi env listTy@(HsListTy _ ty) = do { data_kinds <- xoptM LangExt.DataKinds @@ -1210,46 +1205,40 @@ is always read in as a `op` (b `op` c) mkHsOpTyRn rearranges where necessary. The two arguments -have already been renamed and rearranged. It's made rather tiresome -by the presence of ->, which is a separate syntactic construct. +have already been renamed and rearranged. + +In the past, mkHsOpTyRn used to handle (->), but this was unnecessary, +as the arrow has the least possible fixity in the parser. -} --------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn +mkHsOpTyRn :: Located Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy noExtField ty21 op2 ty22)) +mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 - ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExtField t1 op2 t2) - (unLoc op2) fix2 ty21 ty22 loc2 } - -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy _ mult ty21 ty22)) - = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - hs_fun_ty funTyConName funTyFixity ty21 ty22 loc2 - where - hs_fun_ty a b = HsFunTy noExtField mult a b + ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 } -mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment - = return (mk1 ty1 ty2) +mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment + = return (HsOpTy noExtField ty1 op1 ty2) --------------- -mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn - -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan +mk_hs_op_ty :: Located Name -> Fixity -> LHsType GhcRn + -> Located Name -> Fixity -> LHsType GhcRn + -> LHsType GhcRn -> SrcSpan -> RnM (HsType GhcRn) -mk_hs_op_ty mk1 op1 fix1 ty1 - mk2 op2 fix2 ty21 ty22 loc2 - | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2) - ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } - | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) +mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 + | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1) + (NormalOp (unLoc op2),fix2) + ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) } + | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21 - ; return (mk2 (noLoc new_ty) ty22) } + new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21 + ; return (noLoc new_ty `op2ty` ty22) } where + lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs + lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs (nofix_error, associate_right) = compareFixity fix1 fix2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/954ec03f586c0a11b699806fc9d0a2c7799a438b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/954ec03f586c0a11b699806fc9d0a2c7799a438b You're receiving 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 26 22:30:24 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 18:30:24 -0400 Subject: [Git][ghc/ghc][wip/no-arrow-rearrangement] Don't rearrange (->) in the renamer Message-ID: <5f6fc1001da9d_80bb4cd820148907d9@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/no-arrow-rearrangement at Glasgow Haskell Compiler / GHC Commits: ee0a89c8 by Vladislav Zavialov at 2020-09-27T01:30:15+03:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible fixity 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - 1 changed file: - compiler/GHC/Rename/HsType.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -52,14 +52,13 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names -import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity +import GHC.Types.Basic ( compareFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) import GHC.Utils.Outputable @@ -600,8 +599,7 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) - (unLoc l_op') fix ty1' ty2' + ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) @@ -632,12 +630,9 @@ rnHsTyKi env (HsFunTy _ mult ty1 ty2) -- Or as the result. This happens when reading Prelude.hi -- when we find return :: forall m. Monad m -> forall a. a -> m a - -- Check for fixity rearrangements ; (mult', w_fvs) <- rnHsArrow env mult - ; res_ty <- mkHsOpTyRn (hs_fun_ty mult') funTyConName funTyFixity ty1' ty2' - ; return (res_ty, fvs1 `plusFV` fvs2 `plusFV` w_fvs) } - where - hs_fun_ty w a b = HsFunTy noExtField w a b + ; return (HsFunTy noExtField mult' ty1' ty2' + , plusFVs [fvs1, fvs2, w_fvs]) } rnHsTyKi env listTy@(HsListTy _ ty) = do { data_kinds <- xoptM LangExt.DataKinds @@ -1210,46 +1205,40 @@ is always read in as a `op` (b `op` c) mkHsOpTyRn rearranges where necessary. The two arguments -have already been renamed and rearranged. It's made rather tiresome -by the presence of ->, which is a separate syntactic construct. +have already been renamed and rearranged. + +In the past, mkHsOpTyRn used to handle (->), but this was unnecessary, +as the arrow has the least possible fixity in the parser. -} --------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn +mkHsOpTyRn :: Located Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy noExtField ty21 op2 ty22)) +mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 - ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExtField t1 op2 t2) - (unLoc op2) fix2 ty21 ty22 loc2 } - -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy _ mult ty21 ty22)) - = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - hs_fun_ty funTyConName funTyFixity ty21 ty22 loc2 - where - hs_fun_ty a b = HsFunTy noExtField mult a b + ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 } -mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment - = return (mk1 ty1 ty2) +mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment + = return (HsOpTy noExtField ty1 op1 ty2) --------------- -mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn - -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan +mk_hs_op_ty :: Located Name -> Fixity -> LHsType GhcRn + -> Located Name -> Fixity -> LHsType GhcRn + -> LHsType GhcRn -> SrcSpan -> RnM (HsType GhcRn) -mk_hs_op_ty mk1 op1 fix1 ty1 - mk2 op2 fix2 ty21 ty22 loc2 - | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2) - ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } - | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) +mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 + | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1) + (NormalOp (unLoc op2),fix2) + ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) } + | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21 - ; return (mk2 (noLoc new_ty) ty22) } + new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21 + ; return (noLoc new_ty `op2ty` ty22) } where + lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs + lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs (nofix_error, associate_right) = compareFixity fix1 fix2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0a89c83c47853ec92a1530d1d0ea7c712220f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0a89c83c47853ec92a1530d1d0ea7c712220f7 You're receiving 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 26 23:20:59 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 19:20:59 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] New linear types syntax: a %p -> b Message-ID: <5f6fccdb897d6_80b3f848a348b4c148949c0@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 3422638c by Vladislav Zavialov at 2020-09-27T02:20:48+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3422638c602afc420597dfa4b3668fc05dd55958 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3422638c602afc420597dfa4b3668fc05dd55958 You're receiving 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 26 23:53:34 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 19:53:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/docs-no-merge-ops Message-ID: <5f6fd47e74c16_80b3f848b11c46c148972ed@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/docs-no-merge-ops at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/docs-no-merge-ops You're receiving 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 27 00:01:52 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 20:01:52 -0400 Subject: [Git][ghc/ghc][wip/docs-no-merge-ops] Comments: change outdated reference to mergeOps Message-ID: <5f6fd670e4d48_80b3f8490239a98149025cf@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/docs-no-merge-ops at Glasgow Haskell Compiler / GHC Commits: 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 1 changed file: - compiler/GHC/Hs/Decls.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1566,7 +1566,7 @@ all we are concerned about in the parser is identifying the overall shape of the argument and result types, which we can accomplish by piggybacking on the special treatment given to function arrows. In a future where function arrows aren't given special status in the parser, we will likely have to modify -GHC.Parser.PostProcess.mergeOps to preserve this trick. +GHC.Parser.PostProcess.mkHsOpTyPV to preserve this trick. ----- -- Wrinkle: No nested foralls or contexts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff433824ea4d265fca09de9c26f3fd77a34bb22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff433824ea4d265fca09de9c26f3fd77a34bb22 You're receiving 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 27 00:43:09 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sat, 26 Sep 2020 20:43:09 -0400 Subject: [Git][ghc/ghc][wip/no-arrow-rearrangement] 2 commits: Don't rearrange (->) in the renamer Message-ID: <5f6fe01d1f595_80b8b29af014914378@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/no-arrow-rearrangement at Glasgow Haskell Compiler / GHC Commits: 0a0f2ff6 by Vladislav Zavialov at 2020-09-27T03:41:28+03:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - cc099a82 by Vladislav Zavialov at 2020-09-27T03:42:17+03:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 1 changed file: - compiler/GHC/Rename/HsType.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -52,14 +52,13 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names -import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity +import GHC.Types.Basic ( compareFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) import GHC.Utils.Outputable @@ -600,8 +599,7 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) - (unLoc l_op') fix ty1' ty2' + ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) @@ -627,17 +625,10 @@ rnHsTyKi env ty@(HsRecTy _ flds) rnHsTyKi env (HsFunTy _ mult ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 - -- Might find a for-all as the arg of a function type ; (ty2', fvs2) <- rnLHsTyKi env ty2 - -- Or as the result. This happens when reading Prelude.hi - -- when we find return :: forall m. Monad m -> forall a. a -> m a - - -- Check for fixity rearrangements ; (mult', w_fvs) <- rnHsArrow env mult - ; res_ty <- mkHsOpTyRn (hs_fun_ty mult') funTyConName funTyFixity ty1' ty2' - ; return (res_ty, fvs1 `plusFV` fvs2 `plusFV` w_fvs) } - where - hs_fun_ty w a b = HsFunTy noExtField w a b + ; return (HsFunTy noExtField mult' ty1' ty2' + , plusFVs [fvs1, fvs2, w_fvs]) } rnHsTyKi env listTy@(HsListTy _ ty) = do { data_kinds <- xoptM LangExt.DataKinds @@ -1210,46 +1201,41 @@ is always read in as a `op` (b `op` c) mkHsOpTyRn rearranges where necessary. The two arguments -have already been renamed and rearranged. It's made rather tiresome -by the presence of ->, which is a separate syntactic construct. +have already been renamed and rearranged. + +In the past, mkHsOpTyRn used to handle (->), but this was unnecessary. In the +syntax tree produced by the parser, the arrow already has the least possible +precedence and does not require rearrangement. -} --------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn +mkHsOpTyRn :: Located Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy noExtField ty21 op2 ty22)) +mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 - ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExtField t1 op2 t2) - (unLoc op2) fix2 ty21 ty22 loc2 } - -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy _ mult ty21 ty22)) - = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - hs_fun_ty funTyConName funTyFixity ty21 ty22 loc2 - where - hs_fun_ty a b = HsFunTy noExtField mult a b + ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 } -mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment - = return (mk1 ty1 ty2) +mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment + = return (HsOpTy noExtField ty1 op1 ty2) --------------- -mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn - -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan +mk_hs_op_ty :: Located Name -> Fixity -> LHsType GhcRn + -> Located Name -> Fixity -> LHsType GhcRn + -> LHsType GhcRn -> SrcSpan -> RnM (HsType GhcRn) -mk_hs_op_ty mk1 op1 fix1 ty1 - mk2 op2 fix2 ty21 ty22 loc2 - | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2) - ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } - | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) +mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 + | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1) + (NormalOp (unLoc op2),fix2) + ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) } + | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21 - ; return (mk2 (noLoc new_ty) ty22) } + new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21 + ; return (noLoc new_ty `op2ty` ty22) } where + lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs + lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs (nofix_error, associate_right) = compareFixity fix1 fix2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee0a89c83c47853ec92a1530d1d0ea7c712220f7...cc099a8236f879ceb181d03481b055ede67e4f8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee0a89c83c47853ec92a1530d1d0ea7c712220f7...cc099a8236f879ceb181d03481b055ede67e4f8b You're receiving 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 27 02:25:15 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Sat, 26 Sep 2020 22:25:15 -0400 Subject: [Git][ghc/ghc][wip/T18753] Omit redundant kind equality check in solver Message-ID: <5f6ff80ba9ea7_80b3f848623b7a814916075@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/T18753 at Glasgow Haskell Compiler / GHC Commits: 4c7e736d by Richard Eisenberg at 2020-09-26T22:25:04-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2357,10 +2357,8 @@ lookupFlatCache fam_tc tys lookup_flats flat_cache]) } where lookup_inerts inert_funeqs - | Just (CFunEqCan { cc_ev = ctev, cc_fsk = fsk, cc_tyargs = xis }) + | Just (CFunEqCan { cc_ev = ctev, cc_fsk = fsk }) <- findFunEq inert_funeqs fam_tc tys - , tys `eqTypes` xis -- The lookup might find a near-match; see - -- Note [Use loose types in inert set] = Just (ctEvCoercion ctev, mkTyVarTy fsk, ctEvFlavour ctev) | otherwise = Nothing @@ -2377,16 +2375,14 @@ lookupInInerts loc pty | otherwise -- NB: No caching for equalities, IPs, holes, or errors = return Nothing --- | Look up a dictionary inert. NB: the returned 'CtEvidence' might not --- match the input exactly. Note [Use loose types in inert set]. +-- | Look up a dictionary inert. lookupInertDict :: InertCans -> CtLoc -> Class -> [Type] -> Maybe CtEvidence lookupInertDict (IC { inert_dicts = dicts }) loc cls tys = case findDict dicts loc cls tys of Just ct -> Just (ctEvidence ct) _ -> Nothing --- | Look up a solved inert. NB: the returned 'CtEvidence' might not --- match the input exactly. See Note [Use loose types in inert set]. +-- | Look up a solved inert. lookupSolvedDict :: InertSet -> CtLoc -> Class -> [Type] -> Maybe CtEvidence -- Returns just if exactly this predicate type exists in the solved. lookupSolvedDict (IS { inert_solved_dicts = solved }) loc cls tys @@ -2412,12 +2408,24 @@ foldIrreds k irreds z = foldr k z irreds Note [Use loose types in inert set] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Say we know (Eq (a |> c1)) and we need (Eq (a |> c2)). One is clearly -solvable from the other. So, we do lookup in the inert set using -loose types, which omit the kind-check. - -We must be careful when using the result of a lookup because it may -not match the requested info exactly! +Whenever we are looking up an inert dictionary (CDictCan) or function +equality (CFunEqCan), we use a TcAppMap, which uses the Unique of the +class/type family tycon and then a trie which maps the arguments. This +trie does *not* need to match the kinds of the arguments; this Note +explains why. + +Consider the types ty0 = (T ty1 ty2 ty3 ty4) and ty0' = (T ty1' ty2' ty3' ty4'), +where ty4 and ty4' have different kinds. Let's further assume that both types +ty0 and ty0' are well-typed. Because the kind of T is closed, it must be that +one of the ty1..ty3 does not match ty1'..ty3' (and that the kind of the fourth +argument to T is dependent on whichever one changed). Since we are matching +all arguments, during the inert-set lookup, we know that ty1..ty3 do indeed +match ty1'..ty3'. Therefore, the kind of ty4 and ty4' must match, too -- +without ever looking at it. + +Accordingly, we use LooseTypeMap, which skips the kind check when looking +up a type. I (Richard E) believe this is just an optimization, and that +looking at kinds would be harmless. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c7e736da65f71511d360a087bf5fb757f6a397b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c7e736da65f71511d360a087bf5fb757f6a397b You're receiving 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 27 08:53:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 27 Sep 2020 04:53:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Make 'undefined x' linear in 'x' (#18731) Message-ID: <5f70531545ec3_80b3f842719ce3c1492904f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 6c1961cd by Vladislav Zavialov at 2020-09-27T04:53:32-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - 340e69a7 by Vladislav Zavialov at 2020-09-27T04:53:32-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 13 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Foreign.hs - + testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T - + testsuite/tests/linear/should_fail/LinearFFI.hs - + testsuite/tests/linear/should_fail/LinearFFI.stderr - testsuite/tests/linear/should_fail/all.T - + testsuite/tests/simplCore/should_compile/T18747A.hs - + testsuite/tests/simplCore/should_compile/T18747B.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1486,7 +1486,7 @@ instCoercion (Pair lty rty) g w | isFunTy lty && isFunTy rty -- g :: (t1 -> t2) ~ (t3 -> t4) -- returns t2 ~ t4 - = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->) + = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->) | otherwise -- one forall, one funty... = Nothing ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1566,7 +1566,7 @@ all we are concerned about in the parser is identifying the overall shape of the argument and result types, which we can accomplish by piggybacking on the special treatment given to function arrows. In a future where function arrows aren't given special status in the parser, we will likely have to modify -GHC.Parser.PostProcess.mergeOps to preserve this trick. +GHC.Parser.PostProcess.mkHsOpTyPV to preserve this trick. ----- -- Wrinkle: No nested foralls or contexts ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -52,14 +52,13 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names -import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity +import GHC.Types.Basic ( compareFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) import GHC.Utils.Outputable @@ -600,8 +599,7 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) - (unLoc l_op') fix ty1' ty2' + ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) @@ -627,17 +625,10 @@ rnHsTyKi env ty@(HsRecTy _ flds) rnHsTyKi env (HsFunTy _ mult ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 - -- Might find a for-all as the arg of a function type ; (ty2', fvs2) <- rnLHsTyKi env ty2 - -- Or as the result. This happens when reading Prelude.hi - -- when we find return :: forall m. Monad m -> forall a. a -> m a - - -- Check for fixity rearrangements ; (mult', w_fvs) <- rnHsArrow env mult - ; res_ty <- mkHsOpTyRn (hs_fun_ty mult') funTyConName funTyFixity ty1' ty2' - ; return (res_ty, fvs1 `plusFV` fvs2 `plusFV` w_fvs) } - where - hs_fun_ty w a b = HsFunTy noExtField w a b + ; return (HsFunTy noExtField mult' ty1' ty2' + , plusFVs [fvs1, fvs2, w_fvs]) } rnHsTyKi env listTy@(HsListTy _ ty) = do { data_kinds <- xoptM LangExt.DataKinds @@ -1210,46 +1201,41 @@ is always read in as a `op` (b `op` c) mkHsOpTyRn rearranges where necessary. The two arguments -have already been renamed and rearranged. It's made rather tiresome -by the presence of ->, which is a separate syntactic construct. +have already been renamed and rearranged. + +In the past, mkHsOpTyRn used to handle (->), but this was unnecessary. In the +syntax tree produced by the parser, the arrow already has the least possible +precedence and does not require rearrangement. -} --------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn +mkHsOpTyRn :: Located Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy noExtField ty21 op2 ty22)) +mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 - ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExtField t1 op2 t2) - (unLoc op2) fix2 ty21 ty22 loc2 } - -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy _ mult ty21 ty22)) - = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - hs_fun_ty funTyConName funTyFixity ty21 ty22 loc2 - where - hs_fun_ty a b = HsFunTy noExtField mult a b + ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 } -mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment - = return (mk1 ty1 ty2) +mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment + = return (HsOpTy noExtField ty1 op1 ty2) --------------- -mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn - -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan +mk_hs_op_ty :: Located Name -> Fixity -> LHsType GhcRn + -> Located Name -> Fixity -> LHsType GhcRn + -> LHsType GhcRn -> SrcSpan -> RnM (HsType GhcRn) -mk_hs_op_ty mk1 op1 fix1 ty1 - mk2 op2 fix2 ty21 ty22 loc2 - | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2) - ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } - | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) +mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 + | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1) + (NormalOp (unLoc op2),fix2) + ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) } + | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21 - ; return (mk2 (noLoc new_ty) ty22) } + new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21 + ; return (noLoc new_ty `op2ty` ty22) } where + lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs + lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs (nofix_error, associate_right) = compareFixity fix1 fix2 ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Tc.Gen.App import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC ) +import GHC.Builtin.Types (multiplicityTy) import GHC.Tc.Gen.Head import GHC.Hs import GHC.Tc.Utils.Monad @@ -499,13 +500,17 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args -- - We need the freshly allocated unification variables, to extend -- delta with. -- It's easier just to do the job directly here. - do { arg_nus <- replicateM (countLeadingValArgs args) newOpenFlexiTyVar + do { let valArgsCount = countLeadingValArgs args + ; arg_nus <- replicateM valArgsCount newOpenFlexiTyVar + -- We need variables for multiplicity (#18731) + -- Otherwise, 'undefined x' wouldn't be linear in x + ; mults <- replicateM valArgsCount (newFlexiTyVarTy multiplicityTy) ; res_nu <- newOpenFlexiTyVar ; kind_co <- unifyKind Nothing liftedTypeKind (tyVarKind kappa) ; let delta' = delta `extendVarSetList` (res_nu:arg_nus) arg_tys = mkTyVarTys arg_nus res_ty = mkTyVarTy res_nu - fun_ty' = mkVisFunTysMany arg_tys res_ty + fun_ty' = mkVisFunTys (zipWithEqual "tcInstFun" mkScaled mults arg_tys) res_ty co_wrap = mkWpCastN (mkTcGReflLeftCo Nominal fun_ty' kind_co) acc' = addArgWrap co_wrap acc -- Suppose kappa :: kk ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -243,7 +243,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty -- things are LocalIds. However, it does not need zonking, -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it). - ; imp_decl' <- tcCheckFIType (map scaledThing arg_tys) res_ty imp_decl + ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl -- Can't use sig_ty here because sig_ty :: Type and -- we need HsType Id hence the undefined ; let fi_decl = ForeignImport { fd_name = L nloc id @@ -255,14 +255,14 @@ tcFImport d = pprPanic "tcFImport" (ppr d) -- ------------ Checking types for foreign import ---------------------- -tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport +tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src) -- Foreign import label = do checkCg checkCOrAsmOrLlvmOrInterp -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) - check (isFFILabelTy (mkVisFunTysMany arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) + check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) cconv' <- checkCConv cconv return (CImport (L lc cconv') safety mh l src) @@ -274,7 +274,9 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of - [arg1_ty] -> do checkForeignArgs isFFIExternalTy (map scaledThing arg1_tys) + [Scaled arg1_mult arg1_ty] -> do + checkNoLinearFFI arg1_mult + checkForeignArgs isFFIExternalTy arg1_tys checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty where @@ -290,9 +292,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh case arg_tys of -- The first arg must be Ptr or FunPtr [] -> addErrTc (illegalForeignTyErr Outputable.empty (text "At least one argument expected")) - (arg1_ty:arg_tys) -> do + (Scaled arg1_mult arg1_ty:arg_tys) -> do dflags <- getDynFlags - let curried_res_ty = mkVisFunTysMany arg_tys res_ty + let curried_res_ty = mkVisFunTys arg_tys res_ty + checkNoLinearFFI arg1_mult check (isFFIDynTy curried_res_ty arg1_ty) (illegalForeignTyErr argument) checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys @@ -317,7 +320,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh dflags <- getDynFlags checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty - checkMissingAmpersand dflags arg_tys res_ty + checkMissingAmpersand dflags (map scaledThing arg_tys) res_ty case target of StaticTarget _ _ _ False | not (null arg_tys) -> @@ -405,7 +408,7 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkCg checkCOrAsmOrLlvm checkTc (isCLabelString str) (badCName str) cconv' <- checkCConv cconv - checkForeignArgs isFFIExternalTy (map scaledThing arg_tys) + checkForeignArgs isFFIExternalTy arg_tys checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where @@ -422,10 +425,16 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do -} ------------ Checking argument types for foreign import ---------------------- -checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM () +checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM () checkForeignArgs pred tys = mapM_ go tys where - go ty = check (pred ty) (illegalForeignTyErr argument) + go (Scaled mult ty) = checkNoLinearFFI mult >> + check (pred ty) (illegalForeignTyErr argument) + +checkNoLinearFFI :: Mult -> TcM () -- No linear types in FFI (#18472) +checkNoLinearFFI Many = return () +checkNoLinearFFI _ = addErrTc $ illegalForeignTyErr argument + (text "Linear types are not supported in FFI declarations, see #18472") ------------ Checking result types for foreign calls ---------------------- -- | Check that the type has the form ===================================== testsuite/tests/linear/should_compile/T18731.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE LinearTypes #-} +module T18731 where + +f :: a #-> b +f x = undefined x ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -36,3 +36,4 @@ test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint']) test('LinearTH1', normal, compile, ['']) test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, ['']) test('LinearHole', normal, compile, ['']) +test('T18731', normal, compile, ['']) ===================================== testsuite/tests/linear/should_fail/LinearFFI.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes #-} +module LinearFFI where -- #18472 + +import Foreign.Ptr + +foreign import ccall "exp" c_exp :: Double #-> Double +foreign import stdcall "dynamic" d8 :: FunPtr (IO Int) #-> IO Int +foreign import ccall "wrapper" mkF :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/LinearFFI.stderr ===================================== @@ -0,0 +1,20 @@ + +LinearFFI.hs:6:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "exp" c_exp :: Double #-> Double + +LinearFFI.hs:7:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import stdcall safe "dynamic" d8 + :: FunPtr (IO Int) #-> IO Int + +LinearFFI.hs:8:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "wrapper" mkF + :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -28,3 +28,4 @@ test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) test('LinearPatternGuardWildcard', normal, compile_fail, ['']) +test('LinearFFI', normal, compile_fail, ['']) ===================================== testsuite/tests/simplCore/should_compile/T18747A.hs ===================================== @@ -0,0 +1,82 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T18747A where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type +data SomeSing :: Type -> Type where + SomeSing :: Sing (a :: k) -> SomeSing k + +data SList :: forall a. [a] -> Type where + SNil :: SList '[] + SCons :: Sing x -> Sing xs -> SList (x:xs) +type instance Sing = SList + +data Univ = U1 | K1 Type | Sum Univ Univ | Product Univ Univ + +data SUniv :: Univ -> Type where + SU1 :: SUniv U1 + SK1 :: Sing c -> SUniv (K1 c) + SSum :: Sing a -> Sing b -> SUniv (Sum a b) + SProduct :: Sing a -> Sing b -> SUniv (Product a b) +type instance Sing = SUniv + +data In :: Univ -> Type where + MkU1 :: In U1 + MkK1 :: c -> In (K1 c) + L1 :: In a -> In (Sum a b) + R1 :: In b -> In (Sum a b) + MkProduct :: In a -> In b -> In (Product a b) + +data SIn :: forall u. In u -> Type where + SMkU1 :: SIn MkU1 + SMkK1 :: Sing c -> SIn (MkK1 c) + SL1 :: Sing a -> SIn (L1 a) + SR1 :: Sing b -> SIn (R1 b) + SMkProduct :: Sing a -> Sing b -> SIn (MkProduct a b) +type instance Sing = SIn + +class Generic (a :: Type) where + type Rep a :: Univ + from :: a -> In (Rep a) + to :: In (Rep a) -> a + +class PGeneric (a :: Type) where + type PFrom (x :: a) :: In (Rep a) + type PTo (x :: In (Rep a)) :: a + +class SGeneric k where + sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) + sTo :: forall (a :: In (Rep k)). Sing a -> Sing (PTo a :: k) + sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a + sFot :: forall (a :: In (Rep k)). Sing a -> PFrom (PTo a :: k) :~: a + +instance Generic [a] where + type Rep [a] = Sum U1 (Product (K1 a) (K1 [a])) + from [] = L1 MkU1 + from (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + to (L1 MkU1) = [] + to (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance PGeneric [a] where + type PFrom '[] = L1 MkU1 + type PFrom (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + type PTo (L1 MkU1) = '[] + type PTo (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance SGeneric [a] where + sFrom SNil = SL1 SMkU1 + sFrom (SCons x xs) = SR1 (SMkProduct (SMkK1 x) (SMkK1 xs)) + sTo (SL1 SMkU1) = SNil + sTo (SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))) = SCons x xs + sTof SNil = Refl + sTof SCons{} = Refl + sFot (SL1 SMkU1) = Refl + sFot (SR1 (SMkProduct SMkK1{} SMkK1{})) = Refl ===================================== testsuite/tests/simplCore/should_compile/T18747B.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T18747B where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type + +data SomeSing (k :: Type) where + SomeSing :: Sing (a :: k) -> SomeSing k + +type family Promote (k :: Type) :: Type +type family PromoteX (a :: k) :: Promote k + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +type SingKindX (a :: k) = (PromoteX (DemoteX a) ~~ a) + +class SingKindX k => SingKind k where + toSing :: Demote k -> SomeSing k + +type instance Demote Type = Type +type instance Promote Type = Type +type instance DemoteX (a :: Type) = Demote a +type instance PromoteX (a :: Type) = Promote a + +type instance Demote Bool = Bool +type instance Promote Bool = Bool + +data Foo (a :: Type) where MkFoo :: Foo Bool + +data SFoo :: forall a. Foo a -> Type where + SMkFoo :: SFoo MkFoo +type instance Sing = SFoo + +type instance Demote (Foo a) = Foo (DemoteX a) +type instance Promote (Foo a) = Foo (PromoteX a) + +instance SingKindX a => SingKind (Foo a) where + toSing MkFoo = SomeSing SMkFoo + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -338,3 +338,5 @@ test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) +test('T18747A', normal, compile, ['']) +test('T18747B', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4149828c2935eed35dfdd27c128836adcaf89fae...340e69a751dd1d329ae16a9f50c58b9183535edc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4149828c2935eed35dfdd27c128836adcaf89fae...340e69a751dd1d329ae16a9f50c58b9183535edc You're receiving 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 27 09:06:59 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 27 Sep 2020 05:06:59 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Proof of Concept implementation of in-tree API Annotations Message-ID: <5f7056336ca7a_80bf55172014930592@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 6bd2b8c9 by Alan Zimmerman at 2020-09-26T18:23:25+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 Remove LHsLocalBinds 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. - - - - - 17 changed files: - .gitmodules - compiler/GHC.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bd2b8c9ec28602a2309b8077500922f18b5dabb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6bd2b8c9ec28602a2309b8077500922f18b5dabb You're receiving 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 27 13:44:57 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Sun, 27 Sep 2020 09:44:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/stack_cloning Message-ID: <5f70975961cf5_80b3f84387376c414943194@gitlab.haskell.org.mail> Sven Tennie pushed new branch wip/stack_cloning at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/stack_cloning You're receiving 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 27 14:03:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 27 Sep 2020 10:03:41 -0400 Subject: [Git][ghc/ghc][master] Comments: change outdated reference to mergeOps Message-ID: <5f709bbd51202_80b3f848bd5d1e0149489a3@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 1 changed file: - compiler/GHC/Hs/Decls.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1566,7 +1566,7 @@ all we are concerned about in the parser is identifying the overall shape of the argument and result types, which we can accomplish by piggybacking on the special treatment given to function arrows. In a future where function arrows aren't given special status in the parser, we will likely have to modify -GHC.Parser.PostProcess.mergeOps to preserve this trick. +GHC.Parser.PostProcess.mkHsOpTyPV to preserve this trick. ----- -- Wrinkle: No nested foralls or contexts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff433824ea4d265fca09de9c26f3fd77a34bb22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ff433824ea4d265fca09de9c26f3fd77a34bb22 You're receiving 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 27 14:04:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sun, 27 Sep 2020 10:04:22 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Don't rearrange (->) in the renamer Message-ID: <5f709be6613e7_80b10206ac414952993@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 1 changed file: - compiler/GHC/Rename/HsType.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -52,14 +52,13 @@ import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn import GHC.Tc.Utils.Monad import GHC.Types.Name.Reader import GHC.Builtin.Names -import GHC.Builtin.Types.Prim ( funTyConName ) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Name.Set import GHC.Types.FieldLabel import GHC.Utils.Misc -import GHC.Types.Basic ( compareFixity, funTyFixity, negateFixity +import GHC.Types.Basic ( compareFixity, negateFixity , Fixity(..), FixityDirection(..), LexicalFixity(..) , TypeOrKind(..) ) import GHC.Utils.Outputable @@ -600,8 +599,7 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2) ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2) - (unLoc l_op') fix ty1' ty2' + ; res_ty <- mkHsOpTyRn l_op' fix ty1' ty2' ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } rnHsTyKi env (HsParTy _ ty) @@ -627,17 +625,10 @@ rnHsTyKi env ty@(HsRecTy _ flds) rnHsTyKi env (HsFunTy _ mult ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 - -- Might find a for-all as the arg of a function type ; (ty2', fvs2) <- rnLHsTyKi env ty2 - -- Or as the result. This happens when reading Prelude.hi - -- when we find return :: forall m. Monad m -> forall a. a -> m a - - -- Check for fixity rearrangements ; (mult', w_fvs) <- rnHsArrow env mult - ; res_ty <- mkHsOpTyRn (hs_fun_ty mult') funTyConName funTyFixity ty1' ty2' - ; return (res_ty, fvs1 `plusFV` fvs2 `plusFV` w_fvs) } - where - hs_fun_ty w a b = HsFunTy noExtField w a b + ; return (HsFunTy noExtField mult' ty1' ty2' + , plusFVs [fvs1, fvs2, w_fvs]) } rnHsTyKi env listTy@(HsListTy _ ty) = do { data_kinds <- xoptM LangExt.DataKinds @@ -1210,46 +1201,41 @@ is always read in as a `op` (b `op` c) mkHsOpTyRn rearranges where necessary. The two arguments -have already been renamed and rearranged. It's made rather tiresome -by the presence of ->, which is a separate syntactic construct. +have already been renamed and rearranged. + +In the past, mkHsOpTyRn used to handle (->), but this was unnecessary. In the +syntax tree produced by the parser, the arrow already has the least possible +precedence and does not require rearrangement. -} --------------- -- Building (ty1 `op1` (ty21 `op2` ty22)) -mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn +mkHsOpTyRn :: Located Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy noExtField ty21 op2 ty22)) +mkHsOpTyRn op1 fix1 ty1 (L loc2 (HsOpTy _ ty21 op2 ty22)) = do { fix2 <- lookupTyFixityRn op2 - ; mk_hs_op_ty mk1 pp_op1 fix1 ty1 - (\t1 t2 -> HsOpTy noExtField t1 op2 t2) - (unLoc op2) fix2 ty21 ty22 loc2 } - -mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy _ mult ty21 ty22)) - = mk_hs_op_ty mk1 pp_op1 fix1 ty1 - hs_fun_ty funTyConName funTyFixity ty21 ty22 loc2 - where - hs_fun_ty a b = HsFunTy noExtField mult a b + ; mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 } -mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment - = return (mk1 ty1 ty2) +mkHsOpTyRn op1 _ ty1 ty2 -- Default case, no rearrangment + = return (HsOpTy noExtField ty1 op1 ty2) --------------- -mk_hs_op_ty :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn - -> (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn) - -> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpan +mk_hs_op_ty :: Located Name -> Fixity -> LHsType GhcRn + -> Located Name -> Fixity -> LHsType GhcRn + -> LHsType GhcRn -> SrcSpan -> RnM (HsType GhcRn) -mk_hs_op_ty mk1 op1 fix1 ty1 - mk2 op2 fix2 ty21 ty22 loc2 - | nofix_error = do { precParseErr (NormalOp op1,fix1) (NormalOp op2,fix2) - ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) } - | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) +mk_hs_op_ty op1 fix1 ty1 op2 fix2 ty21 ty22 loc2 + | nofix_error = do { precParseErr (NormalOp (unLoc op1),fix1) + (NormalOp (unLoc op2),fix2) + ; return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) } + | associate_right = return (ty1 `op1ty` (L loc2 (ty21 `op2ty` ty22))) | otherwise = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22) - new_ty <- mkHsOpTyRn mk1 op1 fix1 ty1 ty21 - ; return (mk2 (noLoc new_ty) ty22) } + new_ty <- mkHsOpTyRn op1 fix1 ty1 ty21 + ; return (noLoc new_ty `op2ty` ty22) } where + lhs `op1ty` rhs = HsOpTy noExtField lhs op1 rhs + lhs `op2ty` rhs = HsOpTy noExtField lhs op2 rhs (nofix_error, associate_right) = compareFixity fix1 fix2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ff433824ea4d265fca09de9c26f3fd77a34bb22...a9ce159ba58ca7e8946b46e19b1361588b677a26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ff433824ea4d265fca09de9c26f3fd77a34bb22...a9ce159ba58ca7e8946b46e19b1361588b677a26 You're receiving 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 27 14:05:25 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 10:05:25 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/docs-no-merge-ops Message-ID: <5f709c25a26ff_80b7230b0c14953154@gitlab.haskell.org.mail> Vladislav Zavialov deleted branch wip/docs-no-merge-ops 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 Sun Sep 27 14:05:31 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 10:05:31 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/no-arrow-rearrangement Message-ID: <5f709c2bea975_80b3f8479696e18149533dc@gitlab.haskell.org.mail> Vladislav Zavialov deleted branch wip/no-arrow-rearrangement 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 Sun Sep 27 14:44:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 27 Sep 2020 10:44:44 -0400 Subject: [Git][ghc/ghc][wip/tuple-width] Extend mAX_TUPLE_SIZE to 64 Message-ID: <5f70a55c84a3d_80b3f84869c5cf81495755d@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: Ben Gamari pushed to branch wip/tuple-width at Glasgow Haskell Compiler / GHC Commits: f4f64e07 by GHC GitLab CI at 2020-09-27T14:44:21+00:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. [...] 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: Ben Gamari Subject: [Git][ghc/ghc][wip/tuple-width] Extend mAX_TUPLE_SIZE to 64 Date: Sun, 27 Sep 2020 10:44:44 -0400 Size: 278077 URL: From gitlab at gitlab.haskell.org Sun Sep 27 14:47:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 27 Sep 2020 10:47:06 -0400 Subject: [Git][ghc/ghc][wip/tuple-width] Extend mAX_TUPLE_SIZE to 64 Message-ID: <5f70a5eab83d8_80b3f8411467600149581e9@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: Ben Gamari pushed to branch wip/tuple-width at Glasgow Haskell Compiler / GHC Commits: 67539b61 by GHC GitLab CI at 2020-09-27T14:46:29+00:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. [...] 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: Ben Gamari Subject: [Git][ghc/ghc][wip/tuple-width] Extend mAX_TUPLE_SIZE to 64 Date: Sun, 27 Sep 2020 10:47:06 -0400 Size: 300456 URL: From gitlab at gitlab.haskell.org Sun Sep 27 16:35:11 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 27 Sep 2020 12:35:11 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] 32 commits: Remove the list of loaded modules from the ghci prompt Message-ID: <5f70bf3f73d7e_80b3f8494255cbc14961943@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 692a79ae by Alan Zimmerman at 2020-09-27T17:06:26+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 Remove LHsLocalBinds 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: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bd2b8c9ec28602a2309b8077500922f18b5dabb...692a79ae262907202dfcfe64d328833211e68151 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6bd2b8c9ec28602a2309b8077500922f18b5dabb...692a79ae262907202dfcfe64d328833211e68151 You're receiving 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 27 16:50:46 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 12:50:46 -0400 Subject: [Git][ghc/ghc][wip/bump-base-4.16] Version bump: base-4.16 (#18712) Message-ID: <5f70c2e6e274e_80b3f84643c7af8149632b4@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC Commits: 89bf41fe by Vladislav Zavialov at 2020-09-27T19:49:08+03:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 30 changed files: - compiler/ghc.cabal.in - libraries/array - libraries/base/base.cabal - libraries/base/changelog.md - libraries/deepseq - libraries/directory - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/unix - testsuite/tests/dependent/should_compile/T14729.stderr - testsuite/tests/dependent/should_compile/T15743.stderr - testsuite/tests/dependent/should_compile/T15743e.stderr - testsuite/tests/indexed-types/should_compile/T15711.stderr - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/polykinds/T15592.stderr - testsuite/tests/polykinds/T15592b.stderr - testsuite/tests/printer/T18052a.stderr - testsuite/tests/typecheck/should_compile/T12763.stderr - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -57,7 +57,7 @@ Library Default-Language: Haskell2010 Exposed: False - Build-Depends: base >= 4.11 && < 4.16, + Build-Depends: base >= 4.11 && < 4.17, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, process >= 1 && < 1.7, ===================================== libraries/array ===================================== @@ -1 +1 @@ -Subproject commit ab535173d7885ebfc2005d8da2765f0f52c923ce +Subproject commit 10e6c7e0522367677e4c33cc1c56eb852ef13420 ===================================== libraries/base/base.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 3.0 name: base -version: 4.15.0.0 +version: 4.16.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.16.0.0 *TBA* + + ## 4.15.0.0 *TBA* * `openFile` now calls the `open` system call with an `interruptible` FFI @@ -21,7 +24,7 @@ `ConcFlags`, `DebugFlags`, `CCFlags`, `DoHeapProfile`, `ProfFlags`, `DoTrace`, `TraceFlags`, `TickyFlags`, `ParFlags`, `RTSFlags`, `RTSStats`, `GCStats`, `ByteOrder`, `GeneralCategory`, `SrcLoc` - + * Add rules `unpackUtf8`, `unpack-listUtf8` and `unpack-appendUtf8` to `GHC.Base`. They correspond to their ascii versions and hopefully make it easier for libraries to handle utf8 encoded strings efficiently. @@ -32,8 +35,8 @@ * Add `MonadFix` and `MonadZip` instances for `Complex` * Add `Ix` instances for tuples of size 6 through 15 - -## 4.14.0.0 *TBA* + +## 4.14.0.0 *Jan 2020* * Bundled with GHC 8.10.1 * Add a `TestEquality` instance for the `Compose` newtype. ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit b8c4fb4debaed6ef7eb6940ca4cfea6bd63cc212 +Subproject commit 0fd7fc88aded7d7a7a1c1250fd3dcd9152edba34 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit 49d274dad953db62bc9a634f68cf1b0c5fcbb22c ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit 9088df9f97914664c9360857347d65c32dd6c892 +Subproject commit e60969e693ffea59725cc3ebcae415343ddd0692 ===================================== libraries/ghc-boot-th/ghc-boot-th.cabal.in ===================================== @@ -36,4 +36,4 @@ Library GHC.ForeignSrcLang.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.16 + build-depends: base >= 4.7 && < 4.17 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -62,7 +62,7 @@ Library -- GHC.Version -- GHC.Platform.Host - build-depends: base >= 4.7 && < 4.16, + build-depends: base >= 4.7 && < 4.17, binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -37,7 +37,7 @@ library CPP build-depends: ghc-prim >= 0.5.3 && < 0.8, - base >= 4.9.0 && < 4.16, + base >= 4.9.0 && < 4.17, bytestring >= 0.10.6.0 ghc-options: -Wall ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -72,7 +72,7 @@ library Build-Depends: array == 0.5.*, - base >= 4.8 && < 4.16, + base >= 4.8 && < 4.17, binary == 0.8.*, bytestring == 0.10.*, containers >= 0.5 && < 0.7, ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 2790f1c6ed94990ed51466079e8fb1097129c9b8 +Subproject commit 28ee26ad5b4ae1c0584f2ec11ac53be9671bf878 ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit 772de3f7b43e31178f042ba77c071594845363e3 +Subproject commit fecf0496a65c4be275d613eb0632fecd5a123b69 ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 190492494fe92e8dd42165190b7ac112be1f7389 +Subproject commit 85096ee81af35283eae377893184df2a1240fdc5 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit aadf0f9a804312eb4a5a3d213549d123f85e86d1 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 444f672416a354c3cfde9d94ec237a36be46ef59 +Subproject commit a439b76a645a903757d2410dd70fe44538f45759 ===================================== libraries/template-haskell/template-haskell.cabal.in ===================================== @@ -55,7 +55,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.11 && < 4.16, + base >= 4.11 && < 4.17, ghc-boot-th == @ProjectVersionMunged@, ghc-prim, pretty == 1.1.* ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 3ebb36f4a2c42b74ec4e35efccc2be34c198a830 +Subproject commit 9add7edcc04a9a86aa84a7faea203b654da447d1 ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit ea13d990580273a883368793dfbb826cab5a22d4 +Subproject commit 853f89f218df66edf83650854d0d0dcc1b68db1e ===================================== testsuite/tests/dependent/should_compile/T14729.stderr ===================================== @@ -11,4 +11,4 @@ COERCION AXIOMS FAMILY INSTANCES type instance F Int = Bool -- Defined at T14729.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/dependent/should_compile/T15743.stderr ===================================== @@ -3,4 +3,4 @@ TYPE CONSTRUCTORS forall {k1} k2 (k3 :: k2). Proxy k3 -> k1 -> k2 -> * roles nominal nominal nominal phantom phantom phantom Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/dependent/should_compile/T15743e.stderr ===================================== @@ -1,6 +1,7 @@ TYPE CONSTRUCTORS data type T{14} :: - forall {k1} {k2} {k3} (k4 :: k2) k5. forall k6 -> + forall {k1} {k2} {k3} (k4 :: k2) k5. + forall k6 -> k6 -> Proxy k4 -> (k3 -> *) @@ -21,7 +22,8 @@ TYPE CONSTRUCTORS nominal phantom data type T2{14} :: - forall {k1} {k2} (k3 :: k2) k7. forall k4 -> + forall {k1} {k2} (k3 :: k2) k7. + forall k4 -> k4 -> Proxy k3 -> (k7 -> *) @@ -52,4 +54,4 @@ DATA CONSTRUCTORS (d :: Proxy k5) (e :: Proxy k7). f c -> T k8 a b f c d e Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/indexed-types/should_compile/T15711.stderr ===================================== @@ -3,4 +3,4 @@ TYPE CONSTRUCTORS associated type family F{2} :: forall a. Maybe a -> * roles nominal nominal Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -9,4 +9,4 @@ FAMILY INSTANCES data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/polykinds/T15592.stderr ===================================== @@ -5,4 +5,4 @@ DATA CONSTRUCTORS MkT :: forall {k} k1 (f :: k1 -> k -> *) (a :: k1) (b :: k). f a b -> T f a b -> T f a b Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/polykinds/T15592b.stderr ===================================== @@ -4,4 +4,4 @@ TYPE CONSTRUCTORS forall k (f :: k -> *) (a :: k). f a -> * roles nominal nominal nominal nominal Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/printer/T18052a.stderr ===================================== @@ -6,7 +6,7 @@ TYPE CONSTRUCTORS PATTERN SYNONYMS (:||:) :: forall {a} {b}. a -> b -> (a, b) Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ==================== Tidy Core ==================== Result size of Tidy Core ===================================== testsuite/tests/typecheck/should_compile/T12763.stderr ===================================== @@ -8,4 +8,4 @@ COERCION AXIOMS CLASS INSTANCES instance C Int -- Defined at T12763.hs:9:10 Dependent modules: [] -Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] +Dependent packages: [base-4.16.0.0, ghc-bignum-1.0, ghc-prim-0.7.0] ===================================== testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr ===================================== @@ -8,10 +8,10 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] Valid hole fits include lines :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘base-4.15.0.0:Data.OldList’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) words :: String -> [String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 - (and originally defined in ‘base-4.15.0.0:Data.OldList’)) + (and originally defined in ‘base-4.16.0.0:Data.OldList’)) read :: forall a. Read a => String -> a with read @[String] (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 53231a61f3387379f44864c4fd843059f1c7b77e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89bf41fea7b04ea1650779f73c3a7f84c35b4d90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89bf41fea7b04ea1650779f73c3a7f84c35b4d90 You're receiving 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 27 16:55:56 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 12:55:56 -0400 Subject: [Git][ghc/ghc][wip/bump-base-4.16] 24 commits: Make sizeExpr strict in the size threshold to facilitate WW. Message-ID: <5f70c41c38f1c_80b3f847c641564149664db@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/bump-base-4.16 at Glasgow Haskell Compiler / GHC Commits: 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - d20a0cfa by Vladislav Zavialov at 2020-09-27T19:55:34+03:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Extension.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/HsToCore/Pmc/Types.hs - + compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89bf41fea7b04ea1650779f73c3a7f84c35b4d90...d20a0cfaa93a48a8c537480dbf5cd61566f02ad2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89bf41fea7b04ea1650779f73c3a7f84c35b4d90...d20a0cfaa93a48a8c537480dbf5cd61566f02ad2 You're receiving 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 27 17:09:42 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 13:09:42 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 4 commits: Comments: change outdated reference to mergeOps Message-ID: <5f70c75665771_80b3f84429ae5101496701e@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 8339bc4d by Vladislav Zavialov at 2020-09-27T20:08:28+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3422638c602afc420597dfa4b3668fc05dd55958...8339bc4d413d47482ca3cf7308dc7ed2e78b0b83 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3422638c602afc420597dfa4b3668fc05dd55958...8339bc4d413d47482ca3cf7308dc7ed2e78b0b83 You're receiving 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 27 20:04:57 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Sun, 27 Sep 2020 16:04:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-kind-inference Message-ID: <5f70f069212d_80b3f84942829b0149706bf@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed new branch wip/fix-kind-inference at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-kind-inference You're receiving 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 27 20:55:52 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 16:55:52 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 2 commits: Linear types: fix kind inference when checking datacons Message-ID: <5f70fc5812cb8_80b3f8435105858149762c5@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: d839486f by Krzysztof Gogolewski at 2020-09-27T23:53:27+03:00 Linear types: fix kind inference when checking datacons - - - - - 8ecd56e0 by Vladislav Zavialov at 2020-09-27T23:53:27+03:00 New linear types syntax: a %p -> b Implements GHC Proposal 356 - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8339bc4d413d47482ca3cf7308dc7ed2e78b0b83...8ecd56e04b08a9243957cc9dc312e96af414217a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8339bc4d413d47482ca3cf7308dc7ed2e78b0b83...8ecd56e04b08a9243957cc9dc312e96af414217a You're receiving 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 27 20:57:42 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Sun, 27 Sep 2020 16:57:42 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] New linear types syntax: a %p -> b (#18459) Message-ID: <5f70fcc6d2c6a_80b3f84a030c230149770c5@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 7d3454be by Vladislav Zavialov at 2020-09-27T23:57:31+03:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d3454bef489d42f9bfc074d8150bf540285cead -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d3454bef489d42f9bfc074d8150bf540285cead You're receiving 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 27 21:11:49 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Sun, 27 Sep 2020 17:11:49 -0400 Subject: [Git][ghc/ghc][wip/amg/hasfield-2020] Exclude record updaters from HIE files Message-ID: <5f71001517d55_80b3f849633070c14982589@gitlab.haskell.org.mail> Adam Gundry pushed to branch wip/amg/hasfield-2020 at Glasgow Haskell Compiler / GHC Commits: 57363155 by Adam Gundry at 2020-09-27T22:10:02+01:00 Exclude record updaters from HIE files I'm unsure if this is the right way to accomplish this, or even if this is desireable in the first place, but it prevents them showing up in haddockHypsrcTest. - - - - - 1 changed file: - compiler/GHC/Iface/Ext/Ast.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -42,7 +42,8 @@ import GHC.Driver.Types import GHC.Unit.Module ( ModuleName, ml_hs_file ) import GHC.Utils.Monad ( concatMapM, liftIO ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique ) +import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc, nameUnique, getOccName ) +import GHC.Types.Name.Occurrence ( isRecFldUpdOcc ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.SrcLoc import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType ) @@ -804,7 +805,12 @@ instance ToHie (Context (Located NoExtField)) where toHie _ = pure [] instance HiePass p => ToHie (BindContext (Located (HsBind (GhcPass p)))) where - toHie (BC context scope b@(L span bind)) = + toHie (BC context scope b@(L span bind)) + | FunBind{fun_id = name} <- bind + , case hiePass @p of { HieRn -> isRecFldUpdOcc (getOccName (unLoc name)) + ; HieTc -> isRecFldUpdOcc (getOccName (unLoc name)) + } = pure [] -- Exclude record updaters from HIE files + | otherwise = concatM $ getTypeNode b : case bind of FunBind{fun_id = name, fun_matches = matches, fun_ext = wrap} -> [ toHie $ C (ValBind context scope $ getRealSpan span) name View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/573631554d1dbc6c648314a10695b6a553a8861a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/573631554d1dbc6c648314a10695b6a553a8861a You're receiving 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 27 21:32:01 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 27 Sep 2020 17:32:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/hsmatchcontext Message-ID: <5f7104d123862_80b3f8486cc022814984866@gitlab.haskell.org.mail> Alan Zimmerman pushed new branch wip/az/hsmatchcontext at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/hsmatchcontext You're receiving 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 28 07:11:40 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Mon, 28 Sep 2020 03:11:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-8.6.5-iohk Message-ID: <5f718cac33712_80b8e02b28149875a4@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-8.6.5-iohk at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-8.6.5-iohk You're receiving 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 28 09:52:24 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 05:52:24 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f71b25836a8d_80b3f848b4791a015020623@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: be406df6 by Daniel Rogozin at 2020-09-28T12:51:35+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 8 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,13 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1061,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Type variable ‘a’ = a :: k0 used where a value identifier was expected + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be406df6805c767666bec7fd1525fc2aedbac26f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be406df6805c767666bec7fd1525fc2aedbac26f You're receiving 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 28 10:42:58 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 06:42:58 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f71be32db5cb_80b3f8459792cd815026612@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: bbb0bb9d by Daniel Rogozin at 2020-09-28T13:42:28+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 9 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,13 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1054,14 +1061,18 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1926,9 +1926,19 @@ tc_infer_id lbl id_name RealDataCon con -> return_data_con con PatSynCon ps -> tcPatSynBuilderOcc ps + ATyVar name _ + -> failWithTc $ + text "Type variable" <+> quotes (ppr name) <+> text error_msg + + ATcTyCon ty_con + -> failWithTc $ + text "Type constructor" <+> quotes (ppr (tyConName ty_con)) <+> text error_msg + _ -> failWithTc $ - ppr thing <+> text "used where a value identifier was expected" } + ppr thing <+> panic error_msg } where + error_msg = "used where a value identifier was expected" + return_id id = return (HsVar noExtField (noLoc id), idType id) return_data_con con ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,12 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +349,12 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -186,6 +186,12 @@ demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Type variable ‘a’ used where a value identifier was expected + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbb0bb9d006b4ff7cfeaa94c868b50aaac4b6276 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbb0bb9d006b4ff7cfeaa94c868b50aaac4b6276 You're receiving 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 28 10:50:25 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 28 Sep 2020 06:50:25 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 2 commits: New linear types syntax: a %p -> b (#18459) Message-ID: <5f71bff1379ca_80b3f846a0dd3c8150290dc@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 1d5e7b23 by Vladislav Zavialov at 2020-09-28T13:34:26+03:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 - - - - - 34d8cbd5 by Vladislav Zavialov at 2020-09-28T13:48:18+03:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d3454bef489d42f9bfc074d8150bf540285cead...34d8cbd50c228da9df6c26adf12e611b5075703e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d3454bef489d42f9bfc074d8150bf540285cead...34d8cbd50c228da9df6c26adf12e611b5075703e You're receiving 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 28 11:03:06 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Mon, 28 Sep 2020 07:03:06 -0400 Subject: [Git][ghc/ghc][wip/linear-types-caret] 2 commits: New linear types syntax: a %p -> b (#18459) Message-ID: <5f71c2ea91c87_80b3f842339100c1503504d@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC Commits: 2149a7bf by Vladislav Zavialov at 2020-09-28T14:02:31+03:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - 04cf0a5a by Vladislav Zavialov at 2020-09-28T14:02:41+03:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs - testsuite/tests/linear/should_compile/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34d8cbd50c228da9df6c26adf12e611b5075703e...04cf0a5aa0d664de67e803bf455a28db8506d426 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34d8cbd50c228da9df6c26adf12e611b5075703e...04cf0a5aa0d664de67e803bf455a28db8506d426 You're receiving 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 28 11:34:18 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 07:34:18 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f71ca3a18f35_80b3f8490399974150419ae@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: f0f52f77 by Daniel Rogozin at 2020-09-28T14:33:39+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 9 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,22 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That will make error messages more precise. +Previously, such errors contained only the info that a given value is +out of scope. We promote the namespace of a reader name and look up after that +(see functions promotedRdrName and lookup_promoted). + +In particular, We have the following error message + • Type constructor 'Int' used where a value identifier was expected +when the user writes + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1078,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion] + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1926,9 +1926,19 @@ tc_infer_id lbl id_name RealDataCon con -> return_data_con con PatSynCon ps -> tcPatSynBuilderOcc ps + ATyVar name _ + -> failWithTc $ + text "Type variable" <+> quotes (ppr name) <+> text error_msg + + ATcTyCon ty_con + -> failWithTc $ + text "Type constructor" <+> quotes (ppr (tyConName ty_con)) <+> text error_msg + _ -> failWithTc $ - ppr thing <+> text "used where a value identifier was expected" } + ppr thing <+> panic error_msg } where + error_msg = "used where a value identifier was expected" + return_id id = return (HsVar noExtField (noLoc id), idType id) return_data_con con ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -342,6 +351,14 @@ demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName +-- see Note [Promotion] +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- see Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName +-- see Note [Promotion] in GHC.Rename.Env +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Type variable ‘a’ used where a value identifier was expected + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0f52f77ee272510b69a7d5aa40f585c4dab607b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0f52f77ee272510b69a7d5aa40f585c4dab607b You're receiving 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 28 12:39:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 08:39:07 -0400 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] 795 commits: GHC.Core.Unfold: Refactor traceInline Message-ID: <5f71d96bf2014_80b3f8486f733581505343@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - dffef372 by Sebastian Graf at 2020-09-28T11:25:48+02:00 Nested CPR - - - - - a046f44c by Sebastian Graf at 2020-09-28T11:26:26+02:00 Move tests from stranal to cpranal - - - - - d1670bcc by Sebastian Graf at 2020-09-28T11:26:30+02:00 Accept FacState - - - - - 66998a02 by Sebastian Graf at 2020-09-28T11:29:13+02:00 Factor Cpr and Termination into a joint lattice As a result, we don't even have to export Termination from Cpr. Neat! Also I realised there is a simpler and more sound way to generate and unleash CPR signatures. - - - - - 8c6c7cc7 by Sebastian Graf at 2020-09-28T14:03:36+02:00 Consider unboxing effects of WW better and get rid of hack - - - - - 3ef7a535 by Sebastian Graf at 2020-09-28T14:07:00+02:00 stuff - - - - - d249bb9a by Sebastian Graf at 2020-09-28T14:09:50+02:00 A slew of testsuite changes - - - - - 435f6001 by Sebastian Graf at 2020-09-28T14:09:52+02:00 Fix T1600 - - - - - d75fdcfd by Sebastian Graf at 2020-09-28T14:16:37+02:00 Inline `decodeDoubleInteger` and constant-fold `decodeDouble_Int64#` instead Currently, `decodeDoubleInteger` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE`/`CONSTANT_FOLDED` things since #13143. Also it is a trade-off: The implementation of `decodeDoubleInteger` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `decodeDoubleInteger`. You may wonder how this affects performance of code using `integer-simple`; Apparently, according to @hsyl20 this is not a concern since we will hopefully land !2231 soon. Fixes #18092. - - - - - 63379eeb by Sebastian Graf at 2020-09-28T14:21:14+02:00 Fix primop termination - - - - - 5e06347d by Sebastian Graf at 2020-09-28T14:21:16+02:00 Test for DataCon wrapper CPR - - - - - 15b7e9de by Sebastian Graf at 2020-09-28T14:26:00+02:00 Fix CPR of bottoming functions/primops - - - - - d6e6f8f0 by Sebastian Graf at 2020-09-28T14:26:44+02:00 Fix DataConWrapperCpr and accept other test outputs - - - - - 1550b12c by Sebastian Graf at 2020-09-28T14:26:46+02:00 Accept two more changed test outputs - - - - - f02bba44 by Sebastian Graf at 2020-09-28T14:26:46+02:00 Update CaseBinderCPR with a new function - - - - - db7863de by Sebastian Graf at 2020-09-28T14:26:47+02:00 Don't give the case binder the CPR property - - - - - ddbb5c78 by Sebastian Graf at 2020-09-28T14:26:47+02:00 Prune CPR sigs to constant depth on all bindings - - - - - 38c0d890 by Sebastian Graf at 2020-09-28T14:26:47+02:00 Use variable length coding for ConTags - - - - - 76da5c3e by Sebastian Graf at 2020-09-28T14:26:47+02:00 Accept testuite output - - - - - 6c37acf1 by Sebastian Graf at 2020-09-28T14:26:47+02:00 Don't attach CPR sigs to expandable bindings; transform their unfoldings instead - - - - - 16870c45 by Sebastian Graf at 2020-09-28T14:26:47+02:00 Revert "Don't give the case binder the CPR property" This reverts commit 910edd76d5fe68b58c74f3805112f9faef4f2788. It seems we broke too much with this change. We lost our big win in `fish`. - - - - - 55012c38 by Sebastian Graf at 2020-09-28T14:30:39+02:00 A more modular and configurable approach to optimistic case binder CPR - - - - - 32241ce6 by Sebastian Graf at 2020-09-28T14:30:41+02:00 Fix T9291 - - - - - 610cd633 by Sebastian Graf at 2020-09-28T14:30:42+02:00 Document -fcase-binder-cpr-depth in the user's guide - - - - - d3522129 by Sebastian Graf at 2020-09-28T14:32:21+02:00 Testsuite changes - - - - - 4d31acde by Sebastian Graf at 2020-09-28T14:38:53+02:00 Refactoring around cprAnalBind - - - - - 940a906b by Sebastian Graf at 2020-09-28T14:38:53+02:00 Fix case binder CPR by not looking into unfoldings of case binders - - - - - 3314dc24 by Sebastian Graf at 2020-09-28T14:38:53+02:00 Regard all arity 0 bindings (incl. DataCon apps) as thunks - - - - - 16 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - README.md - 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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8790dbc7d084d91f2bcbf9297e5ec3c2cf1ccf02...3314dc245f2c313d082728742f6bd0f413851fff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8790dbc7d084d91f2bcbf9297e5ec3c2cf1ccf02...3314dc245f2c313d082728742f6bd0f413851fff You're receiving 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 28 14:27:03 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Mon, 28 Sep 2020 10:27:03 -0400 Subject: [Git][ghc/ghc][wip/T18528] Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f71f2b7919b7_80b3f83942c95f0150694d3@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18528 at Glasgow Haskell Compiler / GHC Commits: 4c37c23f by Richard Eisenberg at 2020-09-28T16:26:05+02:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -407,8 +407,9 @@ funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- -- @ --- FUN :: forall {m :: Multiplicity} {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. --- TYPE rep1 -> TYPE rep2 -> * +-- FUN :: forall (m :: Multiplicity) -> +-- forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. +-- TYPE rep1 -> TYPE rep2 -> * -- @ -- -- The runtime representations quantification is left inferred. This ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkNthCo, nthCoRole, mkLRCo, + mkNthCo, mkNthCoFunCo, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, @@ -1052,23 +1052,8 @@ mkNthCo r n co -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4)) - go r n co@(FunCo r0 w arg res) - -- See Note [Function coercions] - -- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) - -- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) - -- Then we want to behave as if co was - -- TyConAppCo mult argk_co resk_co arg_co res_co - -- where - -- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) - -- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) - -- i.e. mkRuntimeRepCo - = case n of - 0 -> ASSERT( r == Nominal ) w - 1 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg - 2 -> ASSERT( r == Nominal ) mkRuntimeRepCo res - 3 -> ASSERT( r == r0 ) arg - 4 -> ASSERT( r == r0 ) res - _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr co) + go _ n (FunCo _ w arg res) + = mkNthCoFunCo n w arg res go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n , (vcat [ ppr tc @@ -1120,7 +1105,28 @@ mkNthCo r n co | otherwise = True - +-- | Extract the nth field of a FunCo +mkNthCoFunCo :: Int -- ^ "n" + -> CoercionN -- ^ multiplicity coercion + -> Coercion -- ^ argument coercion + -> Coercion -- ^ result coercion + -> Coercion -- ^ nth coercion from a FunCo +-- See Note [Function coercions] +-- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) +-- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) +-- Then we want to behave as if co was +-- TyConAppCo mult argk_co resk_co arg_co res_co +-- where +-- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) +-- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) +-- i.e. mkRuntimeRepCo +mkNthCoFunCo n w co1 co2 = case n of + 0 -> w + 1 -> mkRuntimeRepCo co1 + 2 -> mkRuntimeRepCo co2 + 3 -> co1 + 4 -> co2 + _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr w $$ ppr co1 $$ ppr co2) -- | If you're about to call @mkNthCo r n co@, then @r@ should be -- whatever @nthCoRole n co@ returns. ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -332,6 +332,7 @@ opt_co4 env _sym rep r (NthCo _r n co) , Just (_tc, args) <- ASSERT( r == _r ) splitTyConApp_maybe ty = liftCoSubst (chooseRole rep r) env (args `getNth` n) + | Just (ty, _) <- isReflCo_maybe co , n == 0 , Just (tv, _) <- splitForAllTy_maybe ty @@ -342,6 +343,11 @@ opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) = ASSERT( r == r1 ) opt_co4_wrap env sym rep r (cos `getNth` n) +-- see the definition of GHC.Builtin.Types.Prim.funTyCon +opt_co4 env sym rep r (NthCo r1 n (FunCo _r2 w co1 co2)) + = ASSERT( r == r1 ) + opt_co4_wrap env sym rep r (mkNthCoFunCo n w co1 co2) + opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) -- works for both tyvar and covar = ASSERT( r == _r ) @@ -349,18 +355,16 @@ opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) opt_co4_wrap env sym rep Nominal eta opt_co4 env sym rep r (NthCo _r n co) - | TyConAppCo _ _ cos <- co' - , let nth_co = cos `getNth` n + | Just nth_co <- case co' of + TyConAppCo _ _ cos -> Just (cos `getNth` n) + FunCo _ w co1 co2 -> Just (mkNthCoFunCo n w co1 co2) + ForAllCo _ eta _ -> Just eta + _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co else nth_co - | ForAllCo _ eta _ <- co' - = if rep - then opt_co4_wrap (zapLiftingContext env) False True Nominal eta - else eta - | otherwise = wrapRole rep r $ NthCo r n co' where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c37c23fc02f9c6ed100f5898f8a923d49364367 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c37c23fc02f9c6ed100f5898f8a923d49364367 You're receiving 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 28 14:36:46 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 10:36:46 -0400 Subject: [Git][ghc/ghc][wip/T18626] 66 commits: Require happy >=1.20 Message-ID: <5f71f4fed6841_80ba34a1841507131e@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - ea120a2e by Sebastian Graf at 2020-09-28T16:36:37+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 22 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - aclocal.m4 - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/412a98d7f3e56c95c4dd6813a745f6dd896873ed...ea120a2e7b4fcae1be9cd11d6675ad1c17375057 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/412a98d7f3e56c95c4dd6813a745f6dd896873ed...ea120a2e7b4fcae1be9cd11d6675ad1c17375057 You're receiving 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 28 14:38:34 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 10:38:34 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f71f56a76662_80b3f84901ac7c41507325@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 72a2c9e6 by Sebastian Graf at 2020-09-28T16:38:27+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,36 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HSLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HSLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = [] + , abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HSLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> PmGrd + go_export ABE{abe_poly = x, abe_mono = y} + = ASSERT(idType x `eqType` idType y) + PmLet x (Var y) + let exps = map go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +478,41 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +after type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". +We make sure that there is no polymorphism in the way by checking that there +are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about + at y :: forall a. Eq a => ...@), in which case the exports are a simple renaming +substitution that we can capture with 'PmLet'. Ultimately we'll hit those +renamed 'FunBind's, though, which is the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72a2c9e6f74bad297cbb554f0ecffeafcde431d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72a2c9e6f74bad297cbb554f0ecffeafcde431d2 You're receiving 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 28 15:30:07 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 11:30:07 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f72017fa7939_80b3f8459564394150869ab@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: e88462b9 by Daniel Rogozin at 2020-09-28T18:29:35+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 9 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below. +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That makes error messages more precise. +Previously, such errors contained only the info that a given value was +out of scope. We promote the namespace of RdrName and look up after that +(see the functions promotedRdrName and lookup_promoted). + +In particular, we have the following error message + • Type constructor 'Int' used where a value identifier was expected + +when the user writes the following term + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion]. + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1926,6 +1926,16 @@ tc_infer_id lbl id_name RealDataCon con -> return_data_con con PatSynCon ps -> tcPatSynBuilderOcc ps + ATyVar name _ + -> failWithTc $ + text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + + ATcTyCon ty_con + -> failWithTc $ + text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName ty_con)) + _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName mkClsOccFS = mkOccNameFS clsName -- demoteOccName lowers the Namespace of OccName. --- see Note [Demotion] +-- See Note [Demotion]. demoteOccName :: OccName -> Maybe OccName demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName. +-- See Note [Promotion]. +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName. +-- See Note [Promotion] in GHC.Rename.Env. +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Illegal term-level use of the type variable ‘a’ + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e88462b9708a11546c415200cb033c0b1e14aa58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e88462b9708a11546c415200cb033c0b1e14aa58 You're receiving 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 28 15:45:50 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 11:45:50 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] 29 commits: Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f72052e81d72_80b3f845598ba0c15088962@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 2c296909 by Daniel Rogozin at 2020-09-28T18:44:50+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Coverage.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/Pmc.hs - + compiler/GHC/HsToCore/Pmc/Check.hs - + compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs → compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs → compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/PmCheck/Types.hs → compiler/GHC/HsToCore/Pmc/Solver/Types.hs - + compiler/GHC/HsToCore/Pmc/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e88462b9708a11546c415200cb033c0b1e14aa58...2c296909dd9b246a6fa6de70b3ab1a6f07739184 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e88462b9708a11546c415200cb033c0b1e14aa58...2c296909dd9b246a6fa6de70b3ab1a6f07739184 You're receiving 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 28 15:46:18 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 11:46:18 -0400 Subject: [Git][ghc/ghc][wip/nested-cpr-2019] Don't store CPR info for data structures that are NOINLINE Message-ID: <5f72054a77df2_80b3f845598ba0c150910d3@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC Commits: dac38be5 by Sebastian Graf at 2020-09-28T17:46:09+02:00 Don't store CPR info for data structures that are NOINLINE - - - - - 6 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/numeric/should_compile/T14465.stdout - testsuite/tests/simplCore/should_compile/T13143.stderr - testsuite/tests/simplCore/should_compile/T17673.stderr - testsuite/tests/simplCore/should_compile/T7360.stderr - testsuite/tests/stranal/sigs/T18086.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Types.Basic import GHC.Core.DataCon import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Core.Utils ( dumpIdInfoOfProgram ) +import GHC.Core.Utils (exprIsHNF, dumpIdInfoOfProgram ) import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Multiplicity @@ -346,6 +346,8 @@ cprAnalBind top_lvl env widening args id rhs rhs_ty' -- See Note [CPR for thunks] | stays_thunk = trimCprTy rhs_ty + -- See Note [CPR for expandable unfoldings] + | stays_data = topCprType -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty | otherwise = rhs_ty @@ -358,8 +360,10 @@ cprAnalBind top_lvl env widening args id rhs -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict - is_thunk = idArity id == 0 && not (isJoinId id) + is_thunk = not (exprIsHNF rhs) && not (isJoinId id) not_strict = not (isStrictDmd (idDemandInfo id)) + -- See Note [CPR for expandable unfoldings] + stays_data = not is_thunk && idArity id == 0 && not_strict -- See Note [CPR for sum types] (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) @@ -764,7 +768,13 @@ instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 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). +them (and intractable in case of Nested CPR. + +Rather than discarding CPR signatures for expandable data structures only, we +also do so for non-expandable things ('stays_data'). The reason is that if a +data structure has no unfolding (or if the user said NOINLINE), then we don't +want to store CPR signatures. The generated KindReps fall into this category, so +this is really a mandatory special case. Also we don't need to analyse RHSs of expandable bindings: The CPR signature of the binding is never consulted and there may not be let or case expressions ===================================== testsuite/tests/numeric/should_compile/T14465.stdout ===================================== @@ -55,7 +55,6 @@ M.minusOne1 = 1 -- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0} minusOne :: Natural [GblId, - Cpr=*1(#), Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=True, Expandable=False, Guidance=IF_ARGS [] 40 0}] minusOne ===================================== testsuite/tests/simplCore/should_compile/T13143.stderr ===================================== @@ -33,7 +33,6 @@ T13143.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T13143.$trModule3 :: GHC.Types.TrName [GblId, - Cpr=#c1(#), Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T13143.$trModule3 = GHC.Types.TrNameS T13143.$trModule4 @@ -48,7 +47,6 @@ T13143.$trModule2 = "T13143"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T13143.$trModule1 :: GHC.Types.TrName [GblId, - Cpr=#c1(#), Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2 @@ -56,7 +54,6 @@ T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T13143.$trModule :: GHC.Types.Module [GblId, - Cpr=#c1(#c1(#), #c1(#)), Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T13143.$trModule ===================================== testsuite/tests/simplCore/should_compile/T17673.stderr ===================================== @@ -1,6 +1,6 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 56, types: 67, coercions: 5, joins: 0/0} +Result size of Tidy Core = {terms: 55, types: 82, coercions: 6, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T17673.$trModule4 :: GHC.Prim.Addr# @@ -9,7 +9,7 @@ T17673.$trModule4 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T17673.$trModule3 :: GHC.Types.TrName -[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T17673.$trModule3 = GHC.Types.TrNameS T17673.$trModule4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} @@ -19,48 +19,45 @@ T17673.$trModule2 = "T17673"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T17673.$trModule1 :: GHC.Types.TrName -[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T17673.$trModule1 = GHC.Types.TrNameS T17673.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T17673.$trModule :: GHC.Types.Module -[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +[GblId, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] T17673.$trModule = GHC.Types.Module T17673.$trModule3 T17673.$trModule1 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -lvl :: Int -[GblId, Unf=OtherCon []] -lvl = GHC.Types.I# 1# - Rec { --- RHS size: {terms: 27, types: 31, coercions: 0, joins: 0/0} -T17673.$wfacIO [InlPrag=NOINLINE, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) +-- RHS size: {terms: 23, types: 29, coercions: 0, joins: 0/0} +T17673.$wfacIO [InlPrag=NOINLINE, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #) [GblId, Arity=2, Str=, Unf=OtherCon []] T17673.$wfacIO = \ (ww :: GHC.Prim.Int#) (w :: GHC.Prim.State# GHC.Prim.RealWorld) -> case GHC.Prim.<# ww 2# of { - __DEFAULT -> case T17673.$wfacIO (GHC.Prim.-# ww 1#) w of { (# ipv, ipv1 #) -> (# ipv, case ipv1 of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# ww y) } #) }; - 1# -> (# w, lvl #) + __DEFAULT -> case T17673.$wfacIO (GHC.Prim.-# ww 1#) w of { (# ww2, ww3 #) -> (# ww2, GHC.Prim.*# ww ww3 #) }; + 1# -> (# w, 1# #) } end Rec } --- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0} -T17673.facIO1 [InlPrag=NOUSERINLINE[-1]] :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) +-- RHS size: {terms: 14, types: 23, coercions: 0, joins: 0/0} +T17673.facIO1 [InlPrag=NOUSERINLINE[final]] :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #) [GblId, Arity=2, Str=, + Cpr=*c1(*, #c1(#)), Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> T17673.$wfacIO ww1 w1 }}] -T17673.facIO1 = \ (w :: Int) (w1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 -> T17673.$wfacIO ww1 w1 } + Tmpl= \ (w [Occ=Once1!] :: Int) (w1 [Occ=Once1] :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 [Occ=Once1] -> case T17673.$wfacIO ww1 w1 of { (# ww3 [Occ=Once1], ww4 [Occ=Once1] #) -> (# ww3, GHC.Types.I# ww4 #) } }}] +T17673.facIO1 = \ (w :: Int) (w1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 -> case T17673.$wfacIO ww1 w1 of { (# ww3, ww4 #) -> (# ww3, GHC.Types.I# ww4 #) } } --- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0} -facIO [InlPrag=NOUSERINLINE[-1]] :: Int -> IO Int +-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0} +facIO [InlPrag=NOUSERINLINE[final]] :: Int -> IO Int [GblId, Arity=2, Str=, + Cpr=*c1(*, #c1(#)), Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True) - Tmpl= T17673.facIO1 `cast` (_R ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))}] -facIO = T17673.facIO1 `cast` (_R ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) + Tmpl= T17673.facIO1 `cast` (_R # <'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))}] +facIO = T17673.facIO1 `cast` (_R # <'Many>_N ->_R Sym (GHC.Types.N:IO[0] _R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int)) ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,9 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, - Cpr=#c1(#c1(#, #, #c1(#c1(#), #c1(#)), #c1(#), #, #c5(*)), *), - Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -129,9 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, - Cpr=#c1(#c1(#, #, #c1(#c1(#), #c1(#)), #c1(#), #, #c5(*)), *), - Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -194,10 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, - Cpr=#c4(#c1(#c1(#, #, #c1(#, #), #c1(#), #, #c5(*)), *), - #c1(#c1(#, #, #c1(#, #), #c1(#), #, #c5(*)), *)), - Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} ===================================== testsuite/tests/stranal/sigs/T18086.stderr ===================================== @@ -7,9 +7,9 @@ T18086.panic: x ==================== Cpr signatures ==================== -T18086.$trModule: -T18086.m: b -T18086.panic: +T18086.$trModule: * +T18086.m: *b +T18086.panic: * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dac38be5dbeea5a7a03c2c7cb2f893f97ac7f4bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dac38be5dbeea5a7a03c2c7cb2f893f97ac7f4bb You're receiving 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 28 16:05:47 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 12:05:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18154 Message-ID: <5f7209db596d3_80b3f843bbb88441509232a@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18154 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18154 You're receiving 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 28 16:10:46 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 28 Sep 2020 12:10:46 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f720b0694192_80bd47e7f0150955e6@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 42a0bdab by Sebastian Graf at 2020-09-28T18:10:38+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,36 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HSLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HSLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = [] + , abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HSLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> PmGrd + go_export ABE{abe_poly = x, abe_mono = y} + = ASSERT2(idType x `eqType` idType y, ppr x <+> ppr (idType x) <+> ppr y <+> ppr (idType y)) + PmLet x (Var y) + let exps = map go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +478,41 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +after type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". +We make sure that there is no polymorphism in the way by checking that there +are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about + at y :: forall a. Eq a => ...@), in which case the exports are a simple renaming +substitution that we can capture with 'PmLet'. Ultimately we'll hit those +renamed 'FunBind's, though, which is the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42a0bdab7c735ee73aac0400d3d9889a2ab0847d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42a0bdab7c735ee73aac0400d3d9889a2ab0847d You're receiving 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 28 17:41:11 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 28 Sep 2020 13:41:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Don't rearrange (->) in the renamer Message-ID: <5f7220371de6e_80b3f84157c936c151118af@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - d839486f by Krzysztof Gogolewski at 2020-09-27T23:53:27+03:00 Linear types: fix kind inference when checking datacons - - - - - 2149a7bf by Vladislav Zavialov at 2020-09-28T14:02:31+03:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - 04cf0a5a by Vladislav Zavialov at 2020-09-28T14:02:41+03:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - 79803a00 by Ryan Scott at 2020-09-28T13:41:04-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - + testsuite/tests/ghci/scripts/T18501.script - + testsuite/tests/ghci/scripts/T18501.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/340e69a751dd1d329ae16a9f50c58b9183535edc...79803a001d4dfbec71368aa475763c14b9f8fe9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/340e69a751dd1d329ae16a9f50c58b9183535edc...79803a001d4dfbec71368aa475763c14b9f8fe9e You're receiving 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 28 18:00:30 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 14:00:30 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f7224beb94c6_80b3f8469fe40701511408f@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: 7ecb6e36 by Daniel Rogozin at 2020-09-28T21:00:03+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 10 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T - utils/haddock Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below. +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That makes error messages more precise. +Previously, such errors contained only the info that a given value was +out of scope. We promote the namespace of RdrName and look up after that +(see the functions promotedRdrName and lookup_promoted). + +In particular, we have the following error message + • Type constructor 'Int' used where a value identifier was expected + +when the user writes the following term + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion]. + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -768,6 +768,16 @@ tc_infer_id id_name | otherwise -> nonBidirectionalErr id_name + ATyVar name _ + -> failWithTc $ + text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + + ATcTyCon ty_con + -> failWithTc $ + text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName ty_con)) + _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where @@ -1140,4 +1150,3 @@ addExprCtxt e thing_inside exprCtxt :: HsExpr GhcRn -> SDoc exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) - ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName mkClsOccFS = mkOccNameFS clsName -- demoteOccName lowers the Namespace of OccName. --- see Note [Demotion] +-- See Note [Demotion]. demoteOccName :: OccName -> Maybe OccName demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName. +-- See Note [Promotion]. +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName. +-- See Note [Promotion] in GHC.Rename.Env. +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Illegal term-level use of the type variable ‘a’ + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 8c8517d6c82411212452c3c5fca503c7af5ac3da +Subproject commit 2a15172bde75ec151a52fef586d1e362d478aae8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ecb6e36db73404343462330a9b3873091500275 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ecb6e36db73404343462330a9b3873091500275 You're receiving 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 28 18:20:27 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Mon, 28 Sep 2020 14:20:27 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f72296b85c7c_80b3f840dfc68241511489@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: 0264ba5f by Daniel Rogozin at 2020-09-28T21:20:03+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 9 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below. +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That makes error messages more precise. +Previously, such errors contained only the info that a given value was +out of scope. We promote the namespace of RdrName and look up after that +(see the functions promotedRdrName and lookup_promoted). + +In particular, we have the following error message + • Type constructor 'Int' used where a value identifier was expected + +when the user writes the following term + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion]. + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -768,6 +768,16 @@ tc_infer_id id_name | otherwise -> nonBidirectionalErr id_name + ATyVar name _ + -> failWithTc $ + text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + + ATcTyCon ty_con + -> failWithTc $ + text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName ty_con)) + _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where @@ -1140,4 +1150,3 @@ addExprCtxt e thing_inside exprCtxt :: HsExpr GhcRn -> SDoc exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) - ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName mkClsOccFS = mkOccNameFS clsName -- demoteOccName lowers the Namespace of OccName. --- see Note [Demotion] +-- See Note [Demotion]. demoteOccName :: OccName -> Maybe OccName demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName. +-- See Note [Promotion]. +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName. +-- See Note [Promotion] in GHC.Rename.Env. +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Illegal term-level use of the type variable ‘a’ + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0264ba5f6b04ca19550610f5184060787733ae56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0264ba5f6b04ca19550610f5184060787733ae56 You're receiving 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 28 20:51:33 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 28 Sep 2020 16:51:33 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: Bignum: refactor backend modules Message-ID: <5f724cd5c186b_80b3f84901ef74015145764@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 6c98a930 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 74f3f581 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: implement extended GCD (#18427) - - - - - ebcc0968 by Sylvain Henry at 2020-09-28T09:56:49+02:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - 17 changed files: - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - testsuite/tests/lib/integer/all.T - + testsuite/tests/lib/integer/gcdeInteger.hs - + testsuite/tests/lib/integer/gcdeInteger.stdout - testsuite/tests/lib/integer/integerGcdExt.hs Changes: ===================================== libraries/ghc-bignum/cbits/gmp_wrappers.c ===================================== @@ -280,30 +280,32 @@ integer_gmp_mpn_gcd(mp_limb_t r[], /* wraps mpz_gcdext() * * Set g={g0,gn} to the greatest common divisor of x={x0,xn} and - * y={y0,yn}, and in addition set s={s0,sn} to coefficient - * satisfying x*s + y*t = g. - * - * The g0 array is zero-padded (so that gn is fixed). + * y={y0,yn}, and in addition set s={s0,sn} and t={t0,tn} to + * coefficients satisfying x*s + y*t = g. * * g0 must have space for exactly gn=min(xn,yn) limbs. * s0 must have space for at least yn limbs. + * t0 must have space for at least xn limbs. + * + * Actual sizes are returned by pointers. * - * return value: signed 'sn' of s={s0,sn} where |sn| >= 1 */ -mp_size_t -integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], +void +integer_gmp_gcdext(mp_limb_t s0[], int32_t * ssn, + mp_limb_t t0[], int32_t * stn, + mp_limb_t g0[], int32_t * gn, const mp_limb_t x0[], const mp_size_t xn, const mp_limb_t y0[], const mp_size_t yn) { - const mp_size_t gn0 = mp_size_minabs(xn, yn); const mpz_t x = CONST_MPZ_INIT(x0, mp_limb_zero_p(x0,xn) ? 0 : xn); const mpz_t y = CONST_MPZ_INIT(y0, mp_limb_zero_p(y0,yn) ? 0 : yn); - mpz_t g, s; + mpz_t g, s, t; mpz_init (g); mpz_init (s); + mpz_init (t); - mpz_gcdext (g, s, NULL, x, y); + mpz_gcdext (g, s, t, x, y); // g must be positive (0 <= gn). // According to the docs for mpz_gcdext(), we have: @@ -311,28 +313,31 @@ integer_gmp_gcdext(mp_limb_t s0[], mp_limb_t g0[], // --> g < min(|y|, |x|) // --> gn <= min(yn, xn) // <-> gn <= gn0 - const mp_size_t gn = g[0]._mp_size; - assert(0 <= gn && gn <= gn0); - memset(g0, 0, gn0*sizeof(mp_limb_t)); - memcpy(g0, g[0]._mp_d, gn*sizeof(mp_limb_t)); + const mp_size_t gn0 = mp_size_minabs(xn, yn); + *gn = g[0]._mp_size; + assert(0 <= *gn && *gn <= gn0); + memcpy(g0, g[0]._mp_d, *gn * sizeof(mp_limb_t)); mpz_clear (g); // According to the docs for mpz_gcdext(), we have: // |s| < |y| / 2g // --> |s| < |y| (note g > 0) // --> sn <= yn - const mp_size_t ssn = s[0]._mp_size; - const mp_size_t sn = mp_size_abs(ssn); + *ssn = s[0]._mp_size; + const mp_size_t sn = mp_size_abs(*ssn); assert(sn <= mp_size_abs(yn)); memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t)); mpz_clear (s); - if (!sn) { - s0[0] = 0; - return 1; - } - - return ssn; + // According to the docs for mpz_gcdext(), we have: + // |t| < |x| / 2g + // --> |t| < |x| (note g > 0) + // --> st <= xn + *stn = t[0]._mp_size; + const mp_size_t tn = mp_size_abs(*stn); + assert(tn <= mp_size_abs(xn)); + memcpy(t0, t[0]._mp_d, tn*sizeof(mp_limb_t)); + mpz_clear (t); } /* Truncating (i.e. rounded towards zero) integer division-quotient of MPN */ ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -66,15 +66,12 @@ library default-language: Haskell2010 other-extensions: BangPatterns - CApiFFI CPP - DeriveDataTypeable ExplicitForAll GHCForeignImportPrim MagicHash NegativeLiterals NoImplicitPrelude - StandaloneDeriving UnboxedTuples UnliftedFFITypes ForeignFunctionInterface @@ -97,14 +94,14 @@ library if flag(gmp) cpp-options: -DBIGNUM_GMP other-modules: - GHC.Num.BigNat.GMP + GHC.Num.Backend.GMP c-sources: cbits/gmp_wrappers.c if flag(ffi) cpp-options: -DBIGNUM_FFI other-modules: - GHC.Num.BigNat.FFI + GHC.Num.Backend.FFI if flag(native) cpp-options: -DBIGNUM_NATIVE @@ -112,13 +109,15 @@ library if flag(check) cpp-options: -DBIGNUM_CHECK other-modules: - GHC.Num.BigNat.Check + GHC.Num.Backend.Check exposed-modules: GHC.Num.Primitives GHC.Num.WordArray GHC.Num.BigNat - GHC.Num.BigNat.Native + GHC.Num.Backend + GHC.Num.Backend.Selected + GHC.Num.Backend.Native GHC.Num.Natural GHC.Num.Integer ===================================== libraries/ghc-bignum/src/GHC/Num/Backend.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +module GHC.Num.Backend + ( module Backend + ) +where + +#if defined(BIGNUM_CHECK) +import GHC.Num.Backend.Check as Backend +#else +import GHC.Num.Backend.Selected as Backend +#endif + ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs ===================================== @@ -10,25 +10,18 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Check Native implementation against another backend -module GHC.Num.BigNat.Check where +module GHC.Num.Backend.Check where import GHC.Prim import GHC.Types import GHC.Num.WordArray import GHC.Num.Primitives -import qualified GHC.Num.BigNat.Native as Native +import {-# SOURCE #-} GHC.Num.Integer +import qualified GHC.Num.Backend.Native as Native +import qualified GHC.Num.Backend.Selected as Other #if defined(BIGNUM_NATIVE) -#error You can't validate Native backed against itself. Choose another backend (e.g. gmp, ffi) - -#elif defined(BIGNUM_FFI) -import qualified GHC.Num.BigNat.FFI as Other - -#elif defined(BIGNUM_GMP) -import qualified GHC.Num.BigNat.GMP as Other - -#else -#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)` +#error You can't validate Native backend against itself. Choose another backend (e.g. gmp, ffi) #endif default () @@ -461,3 +454,18 @@ bignat_powmod_words b e m = in case gr `eqWord#` nr of 1# -> gr _ -> unexpectedValue_Word# void# + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = + let + !(# g0,x0,y0 #) = Other.integer_gcde a b + !(# g1,x1,y1 #) = Native.integer_gcde a b + in if isTrue# (integerEq# x0 x1 + &&# integerEq# y0 y1 + &&# integerEq# g0 g1) + then (# g0, x0, y0 #) + else case unexpectedValue of + !_ -> (# integerZero, integerZero, integerZero #) ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs ===================================== @@ -13,12 +13,13 @@ -- that replace bignat foreign calls with calls to the native platform bignat -- library (e.g. JavaScript's BigInt). You can also link an extra object -- providing the implementation. -module GHC.Num.BigNat.FFI where +module GHC.Num.Backend.FFI where import GHC.Prim import GHC.Types import GHC.Num.WordArray import GHC.Num.Primitives +import qualified GHC.Num.Backend.Native as Native default () @@ -579,3 +580,19 @@ bignat_powmod_words = ghc_bignat_powmod_words foreign import ccall unsafe ghc_bignat_powmod_words :: Word# -> Word# -> Word# -> Word# + +-- | Return extended GCD of two non-zero integers. +-- +-- I.e. integer_gcde a b returns (g,x,y) so that ax + by = g +-- +-- Input: a and b are non zero. +-- Output: g must be > 0 +-- +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde = Native.integer_gcde + -- for now we use Native's implementation. If some FFI backend user needs a + -- specific implementation, we'll need to determine a prototype to pass and + -- return BigNat signs and sizes via FFI. ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs ===================================== @@ -8,12 +8,15 @@ {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_GHC -Wno-name-shadowing #-} -- | Backend based on the GNU GMP library. -- -- This has been adapted from the legacy `integer-gmp` package written by -- Herbert Valerio Riedel. -module GHC.Num.BigNat.GMP where +module GHC.Num.Backend.GMP where #include "MachDeps.h" #include "WordSize.h" @@ -22,6 +25,9 @@ import GHC.Num.WordArray import GHC.Num.Primitives import GHC.Prim import GHC.Types +import GHC.Magic (runRW#) +import {-# SOURCE #-} GHC.Num.Integer +import {-# SOURCE #-} GHC.Num.BigNat default () @@ -352,6 +358,70 @@ bignat_powmod r b e m s = case ioInt# (integer_gmp_powm# r b (wordArraySize# b) e (wordArraySize# e) m (wordArraySize# m)) s of (# s', n #) -> mwaSetSize# r (narrowGmpSize# n) s' +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = case runRW# io of (# _, a #) -> a + where + !(# sa, ba #) = integerToBigNatSign# a + !(# sb, bb #) = integerToBigNatSign# b + !sza = bigNatSize# ba + !szb = bigNatSize# bb + -- signed sizes of a and b + !ssa = case sa of + 0# -> sza + _ -> negateInt# sza + !ssb = case sb of + 0# -> szb + _ -> negateInt# szb + + -- gcd(a,b) < min(a,b) + !g_init_sz = minI# sza szb + + -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext + -- a*x + b*y = g + -- abs(x) < abs(b) / (2 g) < abs(b) + -- abs(y) < abs(a) / (2 g) < abs(a) + !x_init_sz = szb + !y_init_sz = sza + + io s = + -- allocate output arrays + case newWordArray# g_init_sz s of { (# s, mbg #) -> + case newWordArray# x_init_sz s of { (# s, mbx #) -> + case newWordArray# y_init_sz s of { (# s, mby #) -> + -- allocate space to return sizes (3x4 = 12) + case newPinnedByteArray# 12# s of { (# s, mszs #) -> + case unsafeFreezeByteArray# mszs s of { (# s, szs #) -> + let !ssx_ptr = byteArrayContents# szs in + let !ssy_ptr = ssx_ptr `plusAddr#` 4# in + let !sg_ptr = ssy_ptr `plusAddr#` 4# in + -- call GMP + case ioVoid (integer_gmp_gcdext# mbx ssx_ptr mby ssy_ptr mbg sg_ptr ba ssa bb ssb) s of { s -> + -- read sizes + case readInt32OffAddr# ssx_ptr 0# s of { (# s, ssx #) -> + case readInt32OffAddr# ssy_ptr 0# s of { (# s, ssy #) -> + case readInt32OffAddr# sg_ptr 0# s of { (# s, sg #) -> + case touch# szs s of { s -> + -- shrink x, y and g to their actual sizes and freeze them + let !sx = absI# ssx in + let !sy = absI# ssy in + case mwaSetSize# mbx sx s of { s -> + case mwaSetSize# mby sy s of { s -> + case mwaSetSize# mbg sg s of { s -> + + -- return x, y and g as Integer + case unsafeFreezeByteArray# mbx s of { (# s, bx #) -> + case unsafeFreezeByteArray# mby s of { (# s, by #) -> + case unsafeFreezeByteArray# mbg s of { (# s, bg #) -> + + (# s, (# integerFromBigNat# bg + , integerFromBigNatSign# (ssx <# 0#) bx + , integerFromBigNatSign# (ssy <# 0#) by #) #) + }}}}}}}}}}}}}}}} + + ---------------------------------------------------------------------- -- FFI ccall imports @@ -366,10 +436,13 @@ foreign import ccall unsafe "integer_gmp_mpn_gcd" c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO GmpSize -foreign import ccall unsafe "integer_gmp_gcdext" - integer_gmp_gcdext# :: MutableByteArray# s -> MutableByteArray# s - -> ByteArray# -> GmpSize# - -> ByteArray# -> GmpSize# -> IO GmpSize +foreign import ccall unsafe "integer_gmp_gcdext" integer_gmp_gcdext# + :: MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# + -> IO () -- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, -- mp_limb_t s2limb) ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs ===================================== @@ -9,7 +9,7 @@ {-# LANGUAGE BinaryLiterals #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -module GHC.Num.BigNat.Native where +module GHC.Num.Backend.Native where #include "MachDeps.h" #include "WordSize.h" @@ -17,9 +17,11 @@ module GHC.Num.BigNat.Native where #if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) import {-# SOURCE #-} GHC.Num.BigNat import {-# SOURCE #-} GHC.Num.Natural +import {-# SOURCE #-} GHC.Num.Integer #else import GHC.Num.BigNat import GHC.Num.Natural +import GHC.Num.Integer #endif import GHC.Num.WordArray import GHC.Num.Primitives @@ -717,3 +719,21 @@ bignat_powmod_words b e m = bignat_powmod_word (wordArrayFromWord# b) (wordArrayFromWord# e) m + + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = f (# a,integerOne,integerZero #) (# b,integerZero,integerOne #) + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + + f old@(# old_g, old_s, old_t #) new@(# g, s, t #) + | integerIsZero g = fix old + | True = case integerQuotRem# old_g g of + !(# q, r #) -> f new (# r , old_s `integerSub` (q `integerMul` s) + , old_t `integerSub` (q `integerMul` t) #) ===================================== libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +-- +-- We need this module in addition to GHC.Num.Backend to avoid module loops with +-- Check backend. +module GHC.Num.Backend.Selected + ( module Backend + ) +where + +#if defined(BIGNUM_NATIVE) +import GHC.Num.Backend.Native as Backend + +#elif defined(BIGNUM_FFI) +import GHC.Num.Backend.FFI as Backend + +#elif defined(BIGNUM_GMP) +import GHC.Num.Backend.GMP as Backend + +#else +#error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native, ffi)` +#endif ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs ===================================== @@ -23,27 +23,12 @@ import GHC.Classes import GHC.Magic import GHC.Num.Primitives import GHC.Num.WordArray +import GHC.Num.Backend #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 #endif -#if defined(BIGNUM_CHECK) -import GHC.Num.BigNat.Check - -#elif defined(BIGNUM_NATIVE) -import GHC.Num.BigNat.Native - -#elif defined(BIGNUM_FFI) -import GHC.Num.BigNat.FFI - -#elif defined(BIGNUM_GMP) -import GHC.Num.BigNat.GMP - -#else -#error Undefined BigNat backend. Use a flag to select it (e.g. gmp, native, ffi)` -#endif - default () -- | A BigNat @@ -1535,3 +1520,42 @@ bigNatFromByteArrayBE# sz ba moff s = bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat# #) bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s + + + + +-- | Create a BigNat# from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray# :: WordArray# -> Word# -> BigNat# +bigNatFromWordArray# wa n0 + | isTrue# (n `eqWord#` 0##) + = bigNatZero# void# + + | isTrue# (r `eqWord#` 0##) -- i.e. wa is multiple of limb-size + , isTrue# (q `eqWord#` n) + = wa + + | True = withNewWordArray# (word2Int# n) \mwa s -> + mwaArrayCopy# mwa 0# wa 0# (word2Int# n) s + where + !(# q, r #) = quotRemWord# (int2Word# (sizeofByteArray# wa)) + WORD_SIZE_IN_BYTES## + -- find real size in Words by removing trailing null limbs + !n = real_size n0 + real_size 0## = 0## + real_size i + | 0## <- bigNatIndex# wa (word2Int# (i `minusWord#` 1##)) + = real_size (i `minusWord#` 1##) + real_size i = i + + +-- | Create a BigNat from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray :: WordArray# -> Word# -> BigNat +bigNatFromWordArray wa n = BN# (bigNatFromWordArray# wa n) ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot ===================================== @@ -10,6 +10,7 @@ import GHC.Prim type BigNat# = WordArray# data BigNat = BN# { unBigNat :: BigNat# } +bigNatSize# :: BigNat# -> Int# bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# bigNatMulWord# :: BigNat# -> Word# -> BigNat# bigNatRem :: BigNat# -> BigNat# -> BigNat# ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} -- | -- Module : GHC.Num.Integer @@ -31,6 +32,7 @@ import GHC.Magic import GHC.Num.Primitives import GHC.Num.BigNat import GHC.Num.Natural +import qualified GHC.Num.Backend as Backend #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 @@ -113,6 +115,17 @@ integerFromBigNatSign# !sign !bn | True = integerFromBigNatNeg# bn +-- | Convert an Integer into a sign-bit and a BigNat +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerToBigNatSign# = \case + IS x + | isTrue# (x >=# 0#) + -> (# 0#, bigNatFromWord# (int2Word# x) #) + | True + -> (# 1#, bigNatFromWord# (int2Word# (negateInt# x)) #) + IP x -> (# 0#, x #) + IN x -> (# 1#, x #) + -- | Convert an Integer into a BigNat. -- -- Return 0 for negative Integers. @@ -853,7 +866,7 @@ integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) {-# NOINLINE integerDivMod# #-} integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) - = let !q' = integerAdd q (IS -1#) -- TODO: optimize + = let !q' = integerSub q (IS 1#) !r' = integerAdd r d in (# q', r' #) | True = qr @@ -1169,3 +1182,35 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i + + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde# a b` returns (# g,x,y #) where +-- * ax + by = g = |gcd a b| +integerGcde# + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integerGcde# a b + | integerIsZero a && integerIsZero b = (# integerZero, integerZero, integerZero #) + | integerIsZero a = fix (# b , integerZero, integerOne #) + | integerIsZero b = fix (# a , integerOne, integerZero #) + | integerAbs a `integerEq` integerAbs b = fix (# b , integerZero, integerOne #) + | True = Backend.integer_gcde a b + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde a b` returns (g,x,y) where +-- * ax + by = g = |gcd a b| +integerGcde + :: Integer + -> Integer + -> ( Integer, Integer, Integer) +integerGcde a b = case integerGcde# a b of + (# g,x,y #) -> (g,x,y) ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module GHC.Num.Integer where + +import GHC.Types +import GHC.Prim +import {-# SOURCE #-} GHC.Num.BigNat + +data Integer + +integerZero :: Integer +integerOne :: Integer + +integerEq# :: Integer -> Integer -> Int# +integerEq :: Integer -> Integer -> Bool +integerGt :: Integer -> Integer -> Bool +integerIsZero :: Integer -> Bool +integerIsNegative :: Integer -> Bool + +integerSub :: Integer -> Integer -> Integer +integerMul :: Integer -> Integer -> Integer +integerNegate :: Integer -> Integer +integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) +integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) + +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerFromBigNatSign# :: Int# -> BigNat# -> Integer +integerFromBigNat# :: BigNat# -> Integer ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Integer.GMP.Internals -- ** Additional 'Integer' operations , gcdInteger + , gcdExtInteger , lcmInteger , sqrInteger @@ -52,6 +53,7 @@ module GHC.Integer.GMP.Internals -- ** Conversions to/from 'BigNat' + , byteArrayToBigNat# , wordToBigNat , wordToBigNat2 , bigNatToInt @@ -170,6 +172,12 @@ isValidInteger# = I.integerCheck# gcdInteger :: Integer -> Integer -> Integer gcdInteger = I.integerGcd +{-# DEPRECATED gcdExtInteger "Use integerGcde instead" #-} +gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #) +gcdExtInteger a b = case I.integerGcde# a b of + (# g, s, _t #) -> (# g, s #) + + {-# DEPRECATED lcmInteger "Use integerLcm instead" #-} lcmInteger :: Integer -> Integer -> Integer lcmInteger = I.integerLcm @@ -425,3 +433,8 @@ importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArra 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 #)) + + +{-# DEPRECATED byteArrayToBigNat# "Use bigNatFromWordArray instead" #-} +byteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat +byteArrayToBigNat# ba n = B.bigNatFromWordArray ba (int2Word# n) ===================================== testsuite/tests/lib/integer/all.T ===================================== @@ -5,11 +5,12 @@ test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'] test('fromToInteger', [], makefile_test, ['fromToInteger']) test('IntegerConversionRules', [], makefile_test, ['IntegerConversionRules']) test('gcdInteger', normal, compile_and_run, ['']) +test('gcdeInteger', normal, compile_and_run, ['']) test('integerPowMod', [], compile_and_run, ['']) +test('integerGcdExt', [omit_ways(['ghci'])], compile_and_run, ['']) # skip ghci as it doesn't support unboxed tuples test('integerImportExport', [omit_ways(['ghci'])], compile_and_run, ['']) # Disable GMP only tests -#test('integerGcdExt', [omit_ways(['ghci'])], compile_and_run, ['']) #test('integerGmpInternals', [], compile_and_run, ['']) ===================================== testsuite/tests/lib/integer/gcdeInteger.hs ===================================== @@ -0,0 +1,114 @@ + +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiWayIf #-} + +module Main (main) where + +import GHC.Base +import GHC.Num.Integer +import Control.Monad +import System.Exit + +main :: IO () +main = do + + let test a b = do + putStrLn $ "GCDE " ++ show a ++ " " ++ show b + let r@(g,x,y) = integerGcde a b + putStrLn $ " -> g = " ++ show g + putStrLn $ " -> x = " ++ show x + putStrLn $ " -> y = " ++ show y + let sign a | a >= 0 = 1 + | otherwise = -1 + let assert text cond term + | not cond = return () + | term = return () + | otherwise = do + putStrLn $ "FAILED: " ++ text + putStrLn $ "a*x + b*y = g" + putStrLn $ "a = " ++ show a + putStrLn $ "b = " ++ show b + putStrLn $ "x = " ++ show x + putStrLn $ "y = " ++ show y + putStrLn $ "g = " ++ show g + putStrLn $ "expected g = " ++ show (abs (integerGcd a b)) + exitFailure + + -- check properties + assert "g >= 0" True (g >= 0) + assert "a*x + b*y = g" True (a*x + b*y == g) + assert "g = abs (gcd a b)" True (g == abs (integerGcd a b)) + + if -- special cases + | a == 0 && b == 0 -> do + assert "a == 0 && b ==0 ==> g == 0" (a == 0 && b == 0) (g == 0) + + | abs a == abs b -> do + assert "abs a == abs b ==> x == 0 && y == sign b && g == abs a" + (abs a == abs b) (x == 0 && y == sign b && g == abs a) + + -- non special cases + | otherwise -> do + assert "b == 0 ==> x=sign a" + (b == 0) + (x == sign a) + + assert "abs b == 2g ==> x=sign a" + (abs b == 2*g) + (x == sign a) + + assert "b /= 0 ==> abs x <= abs b / 2*g" + (b /= 0) + (abs x <= abs b `div` 2 * g) + + assert "a /= 0 ==> abs y <= abs a / 2*g" + (a /= 0) + (abs y <= abs a `div` 2 * g) + + assert "a == 0 ==> y=sign b" + (a == 0) + (y == sign b) + + assert "abs a == 2g ==> y==sign b" + (abs a == 2*g) + (y == sign b) + + assert "x == 0 ==> g == abs b" + (x == 0) + (g == abs b) + + nums = + [ 0 + , 1 + , 7 + , 14 + , 123 + , 1230 + , 123456789456789456789456789456789456789465789465456789465454645789 + , 4 * 123456789456789456789456789456789456789465789465456789465454645789 + , -1 + , -123 + , -123456789456789456789456789456789456789465789465456789465454645789 + , 4567897897897897899789897897978978979789 + , 2988348162058574136915891421498819466320163312926952423791023078876139 + , 2351399303373464486466122544523690094744975233415544072992656881240319 + , 5328841272400314897981163497728751426 + , 32052182750761975518649228050096851724 + ] + + forM_ nums $ \a -> + forM_ nums $ \b -> + test a b + + -- see #15350 + do + let a = 2 + b = 2^65 + 1 + test a b + test a (-b) + test (-a) b + test (-a) (-b) + test b a + test b (-a) + test (-b) a + test (-b) (-a) ===================================== testsuite/tests/lib/integer/gcdeInteger.stdout ===================================== @@ -0,0 +1,1056 @@ +GCDE 0 0 + -> g = 0 + -> x = 0 + -> y = 0 +GCDE 0 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 0 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 0 14 + -> g = 14 + -> x = 0 + -> y = 1 +GCDE 0 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 0 1230 + -> g = 1230 + -> x = 0 + -> y = 1 +GCDE 0 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 0 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 0 + -> y = 1 +GCDE 0 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 0 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 0 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 0 4567897897897897899789897897978978979789 + -> g = 4567897897897897899789897897978978979789 + -> x = 0 + -> y = 1 +GCDE 0 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 0 + -> y = 1 +GCDE 0 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 0 + -> y = 1 +GCDE 0 5328841272400314897981163497728751426 + -> g = 5328841272400314897981163497728751426 + -> x = 0 + -> y = 1 +GCDE 0 32052182750761975518649228050096851724 + -> g = 32052182750761975518649228050096851724 + -> x = 0 + -> y = 1 +GCDE 1 0 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 1 7 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 14 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 123 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 1230 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 1 -123 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 5328841272400314897981163497728751426 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 1 32052182750761975518649228050096851724 + -> g = 1 + -> x = 1 + -> y = 0 +GCDE 7 0 + -> g = 7 + -> x = 1 + -> y = 0 +GCDE 7 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 7 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 7 14 + -> g = 7 + -> x = 1 + -> y = 0 +GCDE 7 123 + -> g = 1 + -> x = -35 + -> y = 2 +GCDE 7 1230 + -> g = 1 + -> x = -527 + -> y = 3 +GCDE 7 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -52910052624338338624052909767195481481199624056624338342337705338 + -> y = 3 +GCDE 7 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 70546736832451118165403879689593975308266165408832451123116940451 + -> y = -1 +GCDE 7 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 7 -123 + -> g = 1 + -> x = -35 + -> y = -2 +GCDE 7 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -52910052624338338624052909767195481481199624056624338342337705338 + -> y = -3 +GCDE 7 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1305113685113685114225685113708279708511 + -> y = 2 +GCDE 7 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1280720640882246058678239180642351199851498562682979610196152748089774 + -> y = -3 +GCDE 7 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -671828372392418424704606441292482884212850066690155449426473394640091 + -> y = 2 +GCDE 7 5328841272400314897981163497728751426 + -> g = 1 + -> x = 2283789116742992099134784356169464897 + -> y = -3 +GCDE 7 32052182750761975518649228050096851724 + -> g = 1 + -> x = -13736649750326560936563954878612936453 + -> y = 3 +GCDE 14 0 + -> g = 14 + -> x = 1 + -> y = 0 +GCDE 14 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 14 7 + -> g = 7 + -> x = 0 + -> y = 1 +GCDE 14 14 + -> g = 14 + -> x = 0 + -> y = 1 +GCDE 14 123 + -> g = 1 + -> x = 44 + -> y = -5 +GCDE 14 1230 + -> g = 2 + -> x = 88 + -> y = -1 +GCDE 14 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -26455026312169169312026454883597740740599812028312169171168852669 + -> y = 3 +GCDE 14 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = 70546736832451118165403879689593975308266165408832451123116940451 + -> y = -2 +GCDE 14 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 14 -123 + -> g = 1 + -> x = 44 + -> y = 5 +GCDE 14 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -26455026312169169312026454883597740740599812028312169171168852669 + -> y = -3 +GCDE 14 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1631392106392106392782106392135349635639 + -> y = -5 +GCDE 14 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 640360320441123029339119590321175599925749281341489805098076374044887 + -> y = -3 +GCDE 14 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 839785465490523030880758051615603605266062583362694311783091743300114 + -> y = -5 +GCDE 14 5328841272400314897981163497728751426 + -> g = 2 + -> x = -380631519457165349855797392694910816 + -> y = 1 +GCDE 14 32052182750761975518649228050096851724 + -> g = 2 + -> x = 2289441625054426822760659146435489409 + -> y = -1 +GCDE 123 0 + -> g = 123 + -> x = 1 + -> y = 0 +GCDE 123 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 123 7 + -> g = 1 + -> x = 2 + -> y = -35 +GCDE 123 14 + -> g = 1 + -> x = -5 + -> y = 44 +GCDE 123 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 123 1230 + -> g = 123 + -> x = 1 + -> y = 0 +GCDE 123 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -49181973035631572216938070596607181973039216941523436453717704420 + -> y = 49 +GCDE 123 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -172638762492421029006394860053396638762505006406980225919172350209 + -> y = 43 +GCDE 123 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 123 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 123 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -49181973035631572216938070596607181973039216941523436453717704420 + -> y = -49 +GCDE 123 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 854159769525623184513558143524524524676 + -> y = -23 +GCDE 123 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 1360548756709594729002357069950682033446578418893571835221929206642795 + -> y = -56 +GCDE 123 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -1108789915411877562723862663271333540611451736082126473443691862698687 + -> y = 58 +GCDE 123 5328841272400314897981163497728751426 + -> g = 3 + -> x = 606534778972393565623872268034166829 + -> y = -14 +GCDE 123 32052182750761975518649228050096851724 + -> g = 3 + -> x = 1042347406528844732313796034149491113 + -> y = -4 +GCDE 1230 0 + -> g = 1230 + -> x = 1 + -> y = 0 +GCDE 1230 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 1230 7 + -> g = 1 + -> x = 3 + -> y = -527 +GCDE 1230 14 + -> g = 2 + -> x = -1 + -> y = 88 +GCDE 1230 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE 1230 1230 + -> g = 1230 + -> x = 0 + -> y = 1 +GCDE 1230 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -4918197303563157221693807059660718197303921694152343645371770442 + -> y = 49 +GCDE 1230 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = 113620394849663142346069175337468020394857946077152102174711104905 + -> y = -283 +GCDE 1230 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 1230 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE 1230 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -4918197303563157221693807059660718197303921694152343645371770442 + -> y = -49 +GCDE 1230 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1741743182206596841464603344839139139448 + -> y = 469 +GCDE 1230 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1358119205358327595557710003754341529815423814574119028373318618773790 + -> y = 559 +GCDE 1230 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 594540799470851589667450497029973674362347396416450574553427878102227 + -> y = -311 +GCDE 1230 5328841272400314897981163497728751426 + -> g = 6 + -> x = 298934998207822543057479903531125080 + -> y = -69 +GCDE 1230 32052182750761975518649228050096851724 + -> g = 6 + -> x = -1928342702078362754780522663176558559 + -> y = 74 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 0 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 1 + -> y = 0 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 7 + -> g = 1 + -> x = 3 + -> y = -52910052624338338624052909767195481481199624056624338342337705338 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 14 + -> g = 1 + -> x = 3 + -> y = -26455026312169169312026454883597740740599812028312169171168852669 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 123 + -> g = 1 + -> x = 49 + -> y = -49181973035631572216938070596607181973039216941523436453717704420 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 1230 + -> g = 1 + -> x = 49 + -> y = -4918197303563157221693807059660718197303921694152343645371770442 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 1 + -> y = 0 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -123 + -> g = 1 + -> x = 49 + -> y = 49181973035631572216938070596607181973039216941523436453717704420 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -142355531505412253555567593395647545708 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 501499981494162622976489092493961483514126808861435716131179868189595 + -> y = -20718328076357217180814970215022985846592184263422313201087532586 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 608000101055682152473830041965606704242079033852469328931798308452101 + -> y = -31922158162609726789179865549911873484290325403318594248193251952 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 5328841272400314897981163497728751426 + -> g = 1 + -> x = -233831227202814412604649442847121617 + -> y = 5417322661629453658993420651614628087475941267504880682551205239 +GCDE 123456789456789456789456789456789456789465789465456789465454645789 32052182750761975518649228050096851724 + -> g = 1 + -> x = 2649042575281623182157985423209129457 + -> y = -10203432759063496909071922280945854833629276496909075027106202353 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 0 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 1 + -> y = 0 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 7 + -> g = 1 + -> x = -1 + -> y = 70546736832451118165403879689593975308266165408832451123116940451 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 14 + -> g = 2 + -> x = -2 + -> y = 70546736832451118165403879689593975308266165408832451123116940451 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 123 + -> g = 1 + -> x = 43 + -> y = -172638762492421029006394860053396638762505006406980225919172350209 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 1230 + -> g = 2 + -> x = -283 + -> y = 113620394849663142346069175337468020394857946077152102174711104905 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 493827157827157827157827157827157827157863157861827157861818583156 + -> x = 0 + -> y = 1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -123 + -> g = 1 + -> x = 43 + -> y = 172638762492421029006394860053396638762505006406980225919172350209 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -35588882876353063388891898348911886427 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -621712045141102878484850582251214495701509126016379176914960802671636 + -> y = 102738461380432239608641819241766470942873605202034476264367113203 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 739849851107286659734988146622324199746763566817003350481113797423105 + -> y = -155378947619399183578636655006701330273756114868775383713647897741 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 5328841272400314897981163497728751426 + -> g = 2 + -> x = 1215294704498671518192966153008627048 + -> y = -112622144133530549471469948153560200614513906930447028100352235311 +GCDE 493827157827157827157827157827157827157863157861827157861818583156 32052182750761975518649228050096851724 + -> g = 4 + -> x = 2649042575281623182157985423209129457 + -> y = -40813731036253987636287689123783419334517105987636300108424809412 +GCDE -1 0 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -1 7 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 14 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 123 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 1230 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -1 -123 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 5328841272400314897981163497728751426 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -1 32052182750761975518649228050096851724 + -> g = 1 + -> x = -1 + -> y = 0 +GCDE -123 0 + -> g = 123 + -> x = -1 + -> y = 0 +GCDE -123 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -123 7 + -> g = 1 + -> x = -2 + -> y = -35 +GCDE -123 14 + -> g = 1 + -> x = 5 + -> y = 44 +GCDE -123 123 + -> g = 123 + -> x = 0 + -> y = 1 +GCDE -123 1230 + -> g = 123 + -> x = -1 + -> y = 0 +GCDE -123 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 49181973035631572216938070596607181973039216941523436453717704420 + -> y = 49 +GCDE -123 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 172638762492421029006394860053396638762505006406980225919172350209 + -> y = 43 +GCDE -123 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -123 -123 + -> g = 123 + -> x = 0 + -> y = -1 +GCDE -123 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 49181973035631572216938070596607181973039216941523436453717704420 + -> y = -49 +GCDE -123 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -854159769525623184513558143524524524676 + -> y = -23 +GCDE -123 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1360548756709594729002357069950682033446578418893571835221929206642795 + -> y = -56 +GCDE -123 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 1108789915411877562723862663271333540611451736082126473443691862698687 + -> y = 58 +GCDE -123 5328841272400314897981163497728751426 + -> g = 3 + -> x = -606534778972393565623872268034166829 + -> y = -14 +GCDE -123 32052182750761975518649228050096851724 + -> g = 3 + -> x = -1042347406528844732313796034149491113 + -> y = -4 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 0 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = -1 + -> y = 0 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 7 + -> g = 1 + -> x = -3 + -> y = -52910052624338338624052909767195481481199624056624338342337705338 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 14 + -> g = 1 + -> x = -3 + -> y = -26455026312169169312026454883597740740599812028312169171168852669 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 123 + -> g = 1 + -> x = -49 + -> y = -49181973035631572216938070596607181973039216941523436453717704420 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 1230 + -> g = 1 + -> x = -49 + -> y = -4918197303563157221693807059660718197303921694152343645371770442 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = 1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = -1 + -> y = 0 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -123 + -> g = 1 + -> x = -49 + -> y = 49181973035631572216938070596607181973039216941523436453717704420 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 123456789456789456789456789456789456789465789465456789465454645789 + -> x = 0 + -> y = -1 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 142355531505412253555567593395647545708 + -> y = 3847449587076097018280777909186630028091235782450380442052224817 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -501499981494162622976489092493961483514126808861435716131179868189595 + -> y = -20718328076357217180814970215022985846592184263422313201087532586 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -608000101055682152473830041965606704242079033852469328931798308452101 + -> y = -31922158162609726789179865549911873484290325403318594248193251952 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 5328841272400314897981163497728751426 + -> g = 1 + -> x = 233831227202814412604649442847121617 + -> y = 5417322661629453658993420651614628087475941267504880682551205239 +GCDE -123456789456789456789456789456789456789465789465456789465454645789 32052182750761975518649228050096851724 + -> g = 1 + -> x = -2649042575281623182157985423209129457 + -> y = -10203432759063496909071922280945854833629276496909075027106202353 +GCDE 4567897897897897899789897897978978979789 0 + -> g = 4567897897897897899789897897978978979789 + -> x = 1 + -> y = 0 +GCDE 4567897897897897899789897897978978979789 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 4567897897897897899789897897978978979789 7 + -> g = 1 + -> x = 2 + -> y = -1305113685113685114225685113708279708511 +GCDE 4567897897897897899789897897978978979789 14 + -> g = 1 + -> x = -5 + -> y = 1631392106392106392782106392135349635639 +GCDE 4567897897897897899789897897978978979789 123 + -> g = 1 + -> x = -23 + -> y = 854159769525623184513558143524524524676 +GCDE 4567897897897897899789897897978978979789 1230 + -> g = 1 + -> x = 469 + -> y = -1741743182206596841464603344839139139448 +GCDE 4567897897897897899789897897978978979789 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = -142355531505412253555567593395647545708 +GCDE 4567897897897897899789897897978978979789 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = -35588882876353063388891898348911886427 +GCDE 4567897897897897899789897897978978979789 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 4567897897897897899789897897978978979789 -123 + -> g = 1 + -> x = -23 + -> y = -854159769525623184513558143524524524676 +GCDE 4567897897897897899789897897978978979789 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 3847449587076097018280777909186630028091235782450380442052224817 + -> y = 142355531505412253555567593395647545708 +GCDE 4567897897897897899789897897978978979789 4567897897897897899789897897978978979789 + -> g = 4567897897897897899789897897978978979789 + -> x = 0 + -> y = 1 +GCDE 4567897897897897899789897897978978979789 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -1015458101705415789288140664792006324531958465967800433101537202119645 + -> y = 1552198297064637650702543759558133740654 +GCDE 4567897897897897899789897897978978979789 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 683642522828502349233122722282318495240860998440822891959775694494728 + -> y = -1328064203498637654577318574253233256089 +GCDE 4567897897897897899789897897978978979789 5328841272400314897981163497728751426 + -> g = 1 + -> x = 729028905639966888803280268153493563 + -> y = -624925651816157654399317122483041604031 +GCDE 4567897897897897899789897897978978979789 32052182750761975518649228050096851724 + -> g = 1 + -> x = -12910967943414004413956938074429250463 + -> y = 1839998972523827338782593728961148005767 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 0 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 1 + -> y = 0 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 7 + -> g = 1 + -> x = -3 + -> y = 1280720640882246058678239180642351199851498562682979610196152748089774 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 14 + -> g = 1 + -> x = -3 + -> y = 640360320441123029339119590321175599925749281341489805098076374044887 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 123 + -> g = 1 + -> x = -56 + -> y = 1360548756709594729002357069950682033446578418893571835221929206642795 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 1230 + -> g = 1 + -> x = 559 + -> y = -1358119205358327595557710003754341529815423814574119028373318618773790 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -20718328076357217180814970215022985846592184263422313201087532586 + -> y = 501499981494162622976489092493961483514126808861435716131179868189595 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = 102738461380432239608641819241766470942873605202034476264367113203 + -> y = -621712045141102878484850582251214495701509126016379176914960802671636 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -123 + -> g = 1 + -> x = -56 + -> y = -1360548756709594729002357069950682033446578418893571835221929206642795 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -20718328076357217180814970215022985846592184263422313201087532586 + -> y = -501499981494162622976489092493961483514126808861435716131179868189595 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1552198297064637650702543759558133740654 + -> y = -1015458101705415789288140664792006324531958465967800433101537202119645 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 2988348162058574136915891421498819466320163312926952423791023078876139 + -> x = 0 + -> y = 1 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -238164827888328100873319793437342927637138278785737103723156342382925 + -> y = 302679100340807588460107986194035692812415103244388831792688023418704 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 5328841272400314897981163497728751426 + -> g = 1 + -> x = 88969837841661133174308363831195241 + -> y = -49893182739334638874406212208356173614356037934509167748717979955473 +GCDE 2988348162058574136915891421498819466320163312926952423791023078876139 32052182750761975518649228050096851724 + -> g = 1 + -> x = -2926808101621088968857550652617123241 + -> y = 272877565911469778893036529750941765793334087149670477404511983087875 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 0 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 1 + -> y = 0 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 7 + -> g = 1 + -> x = 2 + -> y = -671828372392418424704606441292482884212850066690155449426473394640091 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 14 + -> g = 1 + -> x = -5 + -> y = 839785465490523030880758051615603605266062583362694311783091743300114 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 123 + -> g = 1 + -> x = 58 + -> y = -1108789915411877562723862663271333540611451736082126473443691862698687 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 1230 + -> g = 1 + -> x = -311 + -> y = 594540799470851589667450497029973674362347396416450574553427878102227 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -31922158162609726789179865549911873484290325403318594248193251952 + -> y = 608000101055682152473830041965606704242079033852469328931798308452101 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 1 + -> x = -155378947619399183578636655006701330273756114868775383713647897741 + -> y = 739849851107286659734988146622324199746763566817003350481113797423105 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -123 + -> g = 1 + -> x = 58 + -> y = 1108789915411877562723862663271333540611451736082126473443691862698687 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -31922158162609726789179865549911873484290325403318594248193251952 + -> y = -608000101055682152473830041965606704242079033852469328931798308452101 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -1328064203498637654577318574253233256089 + -> y = 683642522828502349233122722282318495240860998440822891959775694494728 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 302679100340807588460107986194035692812415103244388831792688023418704 + -> y = -238164827888328100873319793437342927637138278785737103723156342382925 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 2351399303373464486466122544523690094744975233415544072992656881240319 + -> x = 0 + -> y = 1 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 5328841272400314897981163497728751426 + -> g = 1 + -> x = 1320061761887019753142991170712833225 + -> y = -582489165775607532361449347744188527071103823360367325716372563952699 +GCDE 2351399303373464486466122544523690094744975233415544072992656881240319 32052182750761975518649228050096851724 + -> g = 1 + -> x = -3459287250911140032199362006422486237 + -> y = 253778836069059554551347740010931350716760250644753514181097821250371 +GCDE 5328841272400314897981163497728751426 0 + -> g = 5328841272400314897981163497728751426 + -> x = 1 + -> y = 0 +GCDE 5328841272400314897981163497728751426 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 5328841272400314897981163497728751426 7 + -> g = 1 + -> x = -3 + -> y = 2283789116742992099134784356169464897 +GCDE 5328841272400314897981163497728751426 14 + -> g = 2 + -> x = 1 + -> y = -380631519457165349855797392694910816 +GCDE 5328841272400314897981163497728751426 123 + -> g = 3 + -> x = -14 + -> y = 606534778972393565623872268034166829 +GCDE 5328841272400314897981163497728751426 1230 + -> g = 6 + -> x = -69 + -> y = 298934998207822543057479903531125080 +GCDE 5328841272400314897981163497728751426 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 5417322661629453658993420651614628087475941267504880682551205239 + -> y = -233831227202814412604649442847121617 +GCDE 5328841272400314897981163497728751426 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 2 + -> x = -112622144133530549471469948153560200614513906930447028100352235311 + -> y = 1215294704498671518192966153008627048 +GCDE 5328841272400314897981163497728751426 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 5328841272400314897981163497728751426 -123 + -> g = 3 + -> x = -14 + -> y = -606534778972393565623872268034166829 +GCDE 5328841272400314897981163497728751426 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = 5417322661629453658993420651614628087475941267504880682551205239 + -> y = 233831227202814412604649442847121617 +GCDE 5328841272400314897981163497728751426 4567897897897897899789897897978978979789 + -> g = 1 + -> x = -624925651816157654399317122483041604031 + -> y = 729028905639966888803280268153493563 +GCDE 5328841272400314897981163497728751426 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = -49893182739334638874406212208356173614356037934509167748717979955473 + -> y = 88969837841661133174308363831195241 +GCDE 5328841272400314897981163497728751426 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = -582489165775607532361449347744188527071103823360367325716372563952699 + -> y = 1320061761887019753142991170712833225 +GCDE 5328841272400314897981163497728751426 5328841272400314897981163497728751426 + -> g = 5328841272400314897981163497728751426 + -> x = 0 + -> y = 1 +GCDE 5328841272400314897981163497728751426 32052182750761975518649228050096851724 + -> g = 92889294 + -> x = 115110207004456909698806038261 + -> y = -19137667681784054624628973533 +GCDE 32052182750761975518649228050096851724 0 + -> g = 32052182750761975518649228050096851724 + -> x = 1 + -> y = 0 +GCDE 32052182750761975518649228050096851724 1 + -> g = 1 + -> x = 0 + -> y = 1 +GCDE 32052182750761975518649228050096851724 7 + -> g = 1 + -> x = 3 + -> y = -13736649750326560936563954878612936453 +GCDE 32052182750761975518649228050096851724 14 + -> g = 2 + -> x = -1 + -> y = 2289441625054426822760659146435489409 +GCDE 32052182750761975518649228050096851724 123 + -> g = 3 + -> x = -4 + -> y = 1042347406528844732313796034149491113 +GCDE 32052182750761975518649228050096851724 1230 + -> g = 6 + -> x = 74 + -> y = -1928342702078362754780522663176558559 +GCDE 32052182750761975518649228050096851724 123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -10203432759063496909071922280945854833629276496909075027106202353 + -> y = 2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 493827157827157827157827157827157827157863157861827157861818583156 + -> g = 4 + -> x = -40813731036253987636287689123783419334517105987636300108424809412 + -> y = 2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 -1 + -> g = 1 + -> x = 0 + -> y = -1 +GCDE 32052182750761975518649228050096851724 -123 + -> g = 3 + -> x = -4 + -> y = -1042347406528844732313796034149491113 +GCDE 32052182750761975518649228050096851724 -123456789456789456789456789456789456789465789465456789465454645789 + -> g = 1 + -> x = -10203432759063496909071922280945854833629276496909075027106202353 + -> y = -2649042575281623182157985423209129457 +GCDE 32052182750761975518649228050096851724 4567897897897897899789897897978978979789 + -> g = 1 + -> x = 1839998972523827338782593728961148005767 + -> y = -12910967943414004413956938074429250463 +GCDE 32052182750761975518649228050096851724 2988348162058574136915891421498819466320163312926952423791023078876139 + -> g = 1 + -> x = 272877565911469778893036529750941765793334087149670477404511983087875 + -> y = -2926808101621088968857550652617123241 +GCDE 32052182750761975518649228050096851724 2351399303373464486466122544523690094744975233415544072992656881240319 + -> g = 1 + -> x = 253778836069059554551347740010931350716760250644753514181097821250371 + -> y = -3459287250911140032199362006422486237 +GCDE 32052182750761975518649228050096851724 5328841272400314897981163497728751426 + -> g = 92889294 + -> x = -19137667681784054624628973533 + -> y = 115110207004456909698806038261 +GCDE 32052182750761975518649228050096851724 32052182750761975518649228050096851724 + -> g = 32052182750761975518649228050096851724 + -> x = 0 + -> y = 1 +GCDE 2 36893488147419103233 + -> g = 1 + -> x = -18446744073709551616 + -> y = 1 +GCDE 2 -36893488147419103233 + -> g = 1 + -> x = -18446744073709551616 + -> y = -1 +GCDE -2 36893488147419103233 + -> g = 1 + -> x = 18446744073709551616 + -> y = 1 +GCDE -2 -36893488147419103233 + -> g = 1 + -> x = 18446744073709551616 + -> y = -1 +GCDE 36893488147419103233 2 + -> g = 1 + -> x = 1 + -> y = -18446744073709551616 +GCDE 36893488147419103233 -2 + -> g = 1 + -> x = 1 + -> y = 18446744073709551616 +GCDE -36893488147419103233 2 + -> g = 1 + -> x = -1 + -> y = -18446744073709551616 +GCDE -36893488147419103233 -2 + -> g = 1 + -> x = -1 + -> y = 18446744073709551616 ===================================== testsuite/tests/lib/integer/integerGcdExt.hs ===================================== @@ -9,10 +9,10 @@ import Control.Monad import GHC.Word import GHC.Base -import qualified GHC.Integer.GMP.Internals as I +import qualified GHC.Num.Integer as I gcdExtInteger :: Integer -> Integer -> (Integer, Integer) -gcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s) +gcdExtInteger a b = case I.integerGcde a b of ( g, s, _t ) -> (g, s) main :: IO () main = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12957a0b1c74e35f1584b09ba90caa52752be575...ebcc09687b8d84daf00987a466834a20a9831e7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12957a0b1c74e35f1584b09ba90caa52752be575...ebcc09687b8d84daf00987a466834a20a9831e7b You're receiving 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 28 20:58:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 28 Sep 2020 16:58:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f724e7d3f003_80b3f849b7c383c15149393@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 Mon Sep 28 21:00:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 28 Sep 2020 17:00:13 -0400 Subject: [Git][ghc/ghc][wip/backports] Fix handling of function coercions (#18747) Message-ID: <5f724edd3eab9_80b3f8457ad1b6c151495fe@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 409f18b0 by Krzysztof Gogolewski at 2020-09-28T17:00:06-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. (cherry picked from commit e124f2a7d9a5932a4c2383fd3f9dd772b2059885) - - - - - 4 changed files: - compiler/GHC/Core/Coercion.hs - + testsuite/tests/simplCore/should_compile/T18747A.hs - + testsuite/tests/simplCore/should_compile/T18747B.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1469,7 +1469,7 @@ instCoercion (Pair lty rty) g w | isFunTy lty && isFunTy rty -- g :: (t1 -> t2) ~ (t3 -> t4) -- returns t2 ~ t4 - = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->) + = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->) | otherwise -- one forall, one funty... = Nothing ===================================== testsuite/tests/simplCore/should_compile/T18747A.hs ===================================== @@ -0,0 +1,82 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T18747A where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type +data SomeSing :: Type -> Type where + SomeSing :: Sing (a :: k) -> SomeSing k + +data SList :: forall a. [a] -> Type where + SNil :: SList '[] + SCons :: Sing x -> Sing xs -> SList (x:xs) +type instance Sing = SList + +data Univ = U1 | K1 Type | Sum Univ Univ | Product Univ Univ + +data SUniv :: Univ -> Type where + SU1 :: SUniv U1 + SK1 :: Sing c -> SUniv (K1 c) + SSum :: Sing a -> Sing b -> SUniv (Sum a b) + SProduct :: Sing a -> Sing b -> SUniv (Product a b) +type instance Sing = SUniv + +data In :: Univ -> Type where + MkU1 :: In U1 + MkK1 :: c -> In (K1 c) + L1 :: In a -> In (Sum a b) + R1 :: In b -> In (Sum a b) + MkProduct :: In a -> In b -> In (Product a b) + +data SIn :: forall u. In u -> Type where + SMkU1 :: SIn MkU1 + SMkK1 :: Sing c -> SIn (MkK1 c) + SL1 :: Sing a -> SIn (L1 a) + SR1 :: Sing b -> SIn (R1 b) + SMkProduct :: Sing a -> Sing b -> SIn (MkProduct a b) +type instance Sing = SIn + +class Generic (a :: Type) where + type Rep a :: Univ + from :: a -> In (Rep a) + to :: In (Rep a) -> a + +class PGeneric (a :: Type) where + type PFrom (x :: a) :: In (Rep a) + type PTo (x :: In (Rep a)) :: a + +class SGeneric k where + sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) + sTo :: forall (a :: In (Rep k)). Sing a -> Sing (PTo a :: k) + sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a + sFot :: forall (a :: In (Rep k)). Sing a -> PFrom (PTo a :: k) :~: a + +instance Generic [a] where + type Rep [a] = Sum U1 (Product (K1 a) (K1 [a])) + from [] = L1 MkU1 + from (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + to (L1 MkU1) = [] + to (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance PGeneric [a] where + type PFrom '[] = L1 MkU1 + type PFrom (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + type PTo (L1 MkU1) = '[] + type PTo (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance SGeneric [a] where + sFrom SNil = SL1 SMkU1 + sFrom (SCons x xs) = SR1 (SMkProduct (SMkK1 x) (SMkK1 xs)) + sTo (SL1 SMkU1) = SNil + sTo (SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))) = SCons x xs + sTof SNil = Refl + sTof SCons{} = Refl + sFot (SL1 SMkU1) = Refl + sFot (SR1 (SMkProduct SMkK1{} SMkK1{})) = Refl ===================================== testsuite/tests/simplCore/should_compile/T18747B.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T18747B where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type + +data SomeSing (k :: Type) where + SomeSing :: Sing (a :: k) -> SomeSing k + +type family Promote (k :: Type) :: Type +type family PromoteX (a :: k) :: Promote k + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +type SingKindX (a :: k) = (PromoteX (DemoteX a) ~~ a) + +class SingKindX k => SingKind k where + toSing :: Demote k -> SomeSing k + +type instance Demote Type = Type +type instance Promote Type = Type +type instance DemoteX (a :: Type) = Demote a +type instance PromoteX (a :: Type) = Promote a + +type instance Demote Bool = Bool +type instance Promote Bool = Bool + +data Foo (a :: Type) where MkFoo :: Foo Bool + +data SFoo :: forall a. Foo a -> Type where + SMkFoo :: SFoo MkFoo +type instance Sing = SFoo + +type instance Demote (Foo a) = Foo (DemoteX a) +type instance Promote (Foo a) = Foo (PromoteX a) + +instance SingKindX a => SingKind (Foo a) where + toSing MkFoo = SomeSing SMkFoo + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,6 @@ 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('T18747A', normal, compile, ['']) +test('T18747B', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/409f18b00209b1d4c801fe4d282f1b302ded7105 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/409f18b00209b1d4c801fe4d282f1b302ded7105 You're receiving 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 28 22:57:04 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Mon, 28 Sep 2020 18:57:04 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Proof of Concept implementation of in-tree API Annotations Message-ID: <5f726a4017653_80b3f84775d03dc15174590@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 903ce1f8 by Alan Zimmerman at 2020-09-28T23:56:32+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 Remove LHsLocalBinds 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. - - - - - 19 changed files: - compiler/GHC.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.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/Stats.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/903ce1f8ecfd2390104098310519926332d46b6a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/903ce1f8ecfd2390104098310519926332d46b6a You're receiving 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 28 23:31:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 28 Sep 2020 19:31:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f7272512bd4d_80b10618590151828d7@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8e7d131f by Richard Eisenberg at 2020-09-28T19:31:17-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - 71cad817 by Krzysztof Gogolewski at 2020-09-28T19:31:18-04:00 Linear types: fix kind inference when checking datacons - - - - - 9906cafa by Vladislav Zavialov at 2020-09-28T19:31:18-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - 29871d8d by Vladislav Zavialov at 2020-09-28T19:31:18-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - 59104ce5 by Benjamin Maurer at 2020-09-28T19:31:20-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - aa1a7320 by Benjamin Maurer at 2020-09-28T19:31:21-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 1eb75e11 by Ryan Scott at 2020-09-28T19:31:21-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/using.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - rts/posix/OSMem.c - + testsuite/tests/ghci/scripts/T18501.script - + testsuite/tests/ghci/scripts/T18501.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79803a001d4dfbec71368aa475763c14b9f8fe9e...1eb75e11d9604218c84a5ba342c3023511c58ff3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79803a001d4dfbec71368aa475763c14b9f8fe9e...1eb75e11d9604218c84a5ba342c3023511c58ff3 You're receiving 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 29 04:31:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 00:31:36 -0400 Subject: [Git][ghc/ghc][master] Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f72b8a84f0fc_80b3f8486f468301520787f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - 3 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -407,8 +407,9 @@ funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon -- | The @FUN@ type constructor. -- -- @ --- FUN :: forall {m :: Multiplicity} {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. --- TYPE rep1 -> TYPE rep2 -> * +-- FUN :: forall (m :: Multiplicity) -> +-- forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}. +-- TYPE rep1 -> TYPE rep2 -> * -- @ -- -- The runtime representations quantification is left inferred. This ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkNthCo, nthCoRole, mkLRCo, + mkNthCo, mkNthCoFunCo, nthCoRole, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, @@ -1052,23 +1052,8 @@ mkNthCo r n co -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4)) - go r n co@(FunCo r0 w arg res) - -- See Note [Function coercions] - -- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) - -- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) - -- Then we want to behave as if co was - -- TyConAppCo mult argk_co resk_co arg_co res_co - -- where - -- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) - -- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) - -- i.e. mkRuntimeRepCo - = case n of - 0 -> ASSERT( r == Nominal ) w - 1 -> ASSERT( r == Nominal ) mkRuntimeRepCo arg - 2 -> ASSERT( r == Nominal ) mkRuntimeRepCo res - 3 -> ASSERT( r == r0 ) arg - 4 -> ASSERT( r == r0 ) res - _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr co) + go _ n (FunCo _ w arg res) + = mkNthCoFunCo n w arg res go r n (TyConAppCo r0 tc arg_cos) = ASSERT2( r == nthRole r0 tc n , (vcat [ ppr tc @@ -1120,7 +1105,28 @@ mkNthCo r n co | otherwise = True - +-- | Extract the nth field of a FunCo +mkNthCoFunCo :: Int -- ^ "n" + -> CoercionN -- ^ multiplicity coercion + -> Coercion -- ^ argument coercion + -> Coercion -- ^ result coercion + -> Coercion -- ^ nth coercion from a FunCo +-- See Note [Function coercions] +-- If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) +-- ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) +-- Then we want to behave as if co was +-- TyConAppCo mult argk_co resk_co arg_co res_co +-- where +-- argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) +-- resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) +-- i.e. mkRuntimeRepCo +mkNthCoFunCo n w co1 co2 = case n of + 0 -> w + 1 -> mkRuntimeRepCo co1 + 2 -> mkRuntimeRepCo co2 + 3 -> co1 + 4 -> co2 + _ -> pprPanic "mkNthCo(FunCo)" (ppr n $$ ppr w $$ ppr co1 $$ ppr co2) -- | If you're about to call @mkNthCo r n co@, then @r@ should be -- whatever @nthCoRole n co@ returns. ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -332,6 +332,7 @@ opt_co4 env _sym rep r (NthCo _r n co) , Just (_tc, args) <- ASSERT( r == _r ) splitTyConApp_maybe ty = liftCoSubst (chooseRole rep r) env (args `getNth` n) + | Just (ty, _) <- isReflCo_maybe co , n == 0 , Just (tv, _) <- splitForAllTy_maybe ty @@ -342,6 +343,11 @@ opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) = ASSERT( r == r1 ) opt_co4_wrap env sym rep r (cos `getNth` n) +-- see the definition of GHC.Builtin.Types.Prim.funTyCon +opt_co4 env sym rep r (NthCo r1 n (FunCo _r2 w co1 co2)) + = ASSERT( r == r1 ) + opt_co4_wrap env sym rep r (mkNthCoFunCo n w co1 co2) + opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) -- works for both tyvar and covar = ASSERT( r == _r ) @@ -349,18 +355,16 @@ opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) opt_co4_wrap env sym rep Nominal eta opt_co4 env sym rep r (NthCo _r n co) - | TyConAppCo _ _ cos <- co' - , let nth_co = cos `getNth` n + | Just nth_co <- case co' of + TyConAppCo _ _ cos -> Just (cos `getNth` n) + FunCo _ w co1 co2 -> Just (mkNthCoFunCo n w co1 co2) + ForAllCo _ eta _ -> Just eta + _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co else nth_co - | ForAllCo _ eta _ <- co' - = if rep - then opt_co4_wrap (zapLiftingContext env) False True Nominal eta - else eta - | otherwise = wrapRole rep r $ NthCo r n co' where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/583a2070f1ad9162a365b034b27c3b80daafb8df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/583a2070f1ad9162a365b034b27c3b80daafb8df You're receiving 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 29 04:32:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 00:32:13 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Linear types: fix kind inference when checking datacons Message-ID: <5f72b8cd57305_80bd45981015211365@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - 30 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs - testsuite/tests/linear/should_compile/LinearEmptyCase.hs - testsuite/tests/linear/should_compile/LinearGuards.hs - testsuite/tests/linear/should_compile/LinearHole.hs - testsuite/tests/linear/should_compile/LinearTH2.hs - testsuite/tests/linear/should_compile/MultConstructor.hs - testsuite/tests/linear/should_compile/OldList.hs - testsuite/tests/linear/should_compile/Pr110.hs - testsuite/tests/linear/should_compile/T18731.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/583a2070f1ad9162a365b034b27c3b80daafb8df...bca4d36dd835c1c31c8f3364113586e1aedc6787 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/583a2070f1ad9162a365b034b27c3b80daafb8df...bca4d36dd835c1c31c8f3364113586e1aedc6787 You're receiving 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 29 04:32:51 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 00:32:51 -0400 Subject: [Git][ghc/ghc][master] Description of flag `-H` was in 'verbosity options', moved to 'misc'. Message-ID: <5f72b8f3167f5_80b3f8486f46830152158bd@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 1 changed file: - docs/users_guide/using.rst Changes: ===================================== docs/users_guide/using.rst ===================================== @@ -1255,14 +1255,6 @@ messages and in GHCi: the errors and warnings that originate later in the file are displayed first. -.. ghc-flag:: -H ⟨size⟩ - :shortdesc: Set the minimum size of the heap to ⟨size⟩ - :type: dynamic - :category: misc - - Set the minimum size of the heap to ⟨size⟩. This option is - equivalent to ``+RTS -Hsize``, see :ref:`rts-options-gc`. - .. ghc-flag:: -Rghc-timing :shortdesc: Summarise timing stats for GHC (same as ``+RTS -tstderr``). :type: dynamic @@ -1508,6 +1500,14 @@ Some flags only make sense for a particular use case. ``ghcversions.h`` file to be included. This is primarily intended to be used by GHC's build system. +.. ghc-flag:: -H ⟨size⟩ + :shortdesc: Set the minimum size of the heap to ⟨size⟩ + :type: dynamic + :category: misc + + Set the minimum size of the heap to ⟨size⟩. This option is + equivalent to ``+RTS -Hsize``, see :ref:`rts-options-gc`. + Other environment variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9635d0a9bbb7f659c376b68cdc87223c864243c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9635d0a9bbb7f659c376b68cdc87223c864243c You're receiving 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 29 04:33:28 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 00:33:28 -0400 Subject: [Git][ghc/ghc][master] Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve Message-ID: <5f72b918aa2f_80bae2c00c1522021@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 2 changed files: - rts/posix/OSMem.c - + testsuite/tests/rts/T18623/all.T Changes: ===================================== rts/posix/OSMem.c ===================================== @@ -39,6 +39,7 @@ #if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) #include #include +#include #endif #include @@ -545,13 +546,57 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) } #if defined(HAVE_SYS_RESOURCE_H) && defined(HAVE_SYS_TIME_H) - struct rlimit limit; + struct rlimit asLimit; /* rlim_t is signed on some platforms, including FreeBSD; * explicitly cast to avoid sign compare error */ - if (!getrlimit(RLIMIT_AS, &limit) - && limit.rlim_cur > 0 - && *len > (W_) limit.rlim_cur) { - *len = (W_) limit.rlim_cur; + if (!getrlimit(RLIMIT_AS, &asLimit) + && asLimit.rlim_cur > 0 + && *len > (W_) asLimit.rlim_cur) { + + /* In case address space/virtual memory was limited by rlimit (ulimit), + we try to reserver 2/3 of that limit. If we take all, there'll be + nothing left for spawning system threads etc. and we'll crash + (See #18623) + */ + + pthread_attr_t threadAttr; + if (pthread_attr_init(&threadAttr)) { + // Never fails on Linux + sysErrorBelch("failed to initialize thread attributes"); + stg_exit(EXIT_FAILURE); + } + + size_t stacksz = 0; + if (pthread_attr_getstacksize(&threadAttr, &stacksz)) { + // Should never fail + sysErrorBelch("failed to read default thread stack size"); + stg_exit(EXIT_FAILURE); + } + + // Cleanup + if (pthread_attr_destroy(&threadAttr)) { + // Should never fail + sysErrorBelch("failed to destroy thread attributes"); + stg_exit(EXIT_FAILURE); + } + + size_t pageSize = getPageSize(); + // 2/3rds of limit, round down to multiple of PAGE_SIZE + *len = (W_) (asLimit.rlim_cur * 0.666) & ~(pageSize - 1); + + // debugBelch("New len: %zu, pageSize: %zu\n", *len, pageSize); + + /* Make sure we leave enough vmem for at least three threads. + This number was found through trial and error. We're at least launching + that many threads (e.g., itimer). We can't know for sure how much we need, + but at least we can fail early and give a useful error message in this case. */ + if (((W_) (asLimit.rlim_cur - *len )) < ((W_) (stacksz * 3))) { + // Three stacks is 1/3 of needed, then convert to Megabyte + size_t needed = (stacksz * 3 * 3) / (1024 * 1024); + errorBelch("the current resource limit for virtual memory ('ulimit -v' or RLIMIT_AS) is too low.\n" + "Please make sure that at least %zuMiB of virtual memory are available.", needed); + stg_exit(EXIT_FAILURE); + } } #endif @@ -577,9 +622,11 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len) // of memory will be wasted (e.g. imagine a machine with 512GB of // physical memory but a 511GB ulimit). See #14492. *len -= *len / 8; + // debugBelch("Limit hit, reduced len: %zu\n", *len); } else if ((W_)at >= minimumAddress) { // Success! We were given a block of memory starting above the 8 GB // mark, which is what we were looking for. + break; } else { // We got addressing space but it wasn't above the 8GB mark. ===================================== testsuite/tests/rts/T18623/all.T ===================================== @@ -0,0 +1,6 @@ +# Starting GHC on *nix with vmem limit, RTS will reserve all available memory +# and crash when creating a thread. Fix reserves only 2/3rds of vmem_limit. +test('T18623', + [when(opsys('mingw32'), skip), cmd_prefix('ulimit -v ' + str(1024 ** 2) + ' && '), ignore_stdout], + run_command, + ['{compiler} --version']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74c797f6b72c4d01f5e0092dfac1461f3f3dd7a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74c797f6b72c4d01f5e0092dfac1461f3f3dd7a2 You're receiving 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 29 04:34:03 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 00:34:03 -0400 Subject: [Git][ghc/ghc][master] Add regression test #18501 Message-ID: <5f72b93b74bc1_80b5b90168152229b0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 3 changed files: - + testsuite/tests/ghci/scripts/T18501.script - + testsuite/tests/ghci/scripts/T18501.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== testsuite/tests/ghci/scripts/T18501.script ===================================== @@ -0,0 +1,3 @@ +:set -XAllowAmbiguousTypes +class Foo a where foo :: String +:t foo ===================================== testsuite/tests/ghci/scripts/T18501.stdout ===================================== @@ -0,0 +1 @@ +foo :: Foo a => String ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -318,4 +318,5 @@ 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('T18501', normal, ghci_script, ['T18501.script']) test('T18644', normal, ghci_script, ['T18644.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4365d77a0b306ada61654c3648b844cfa0f4fdcf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4365d77a0b306ada61654c3648b844cfa0f4fdcf You're receiving 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 29 08:50:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 04:50:31 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f72f557f21f3_80b3f8459d4bfd01525422b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 503bb3a1 by Sebastian Graf at 2020-09-29T10:50:24+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,39 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HSLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HSLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = [] + , abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HSLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap} + | isIdHsWrapper wrap + = ASSERT2(idType x `eqType` idType y, ppr x <+> ppr (idType x) <+> ppr y <+> ppr (idType y)) + Just $ PmLet x (Var y) + | otherwise + = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +481,41 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +after type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". +We make sure that there is no polymorphism in the way by checking that there +are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about + at y :: forall a. Eq a => ...@), in which case the exports are a simple renaming +substitution that we can capture with 'PmLet'. Ultimately we'll hit those +renamed 'FunBind's, though, which is the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/503bb3a1a308b6eb1d8ee20378d10add714c124f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/503bb3a1a308b6eb1d8ee20378d10add714c124f You're receiving 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 29 09:10:09 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 05:10:09 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f72f9f1acfd4_80bae04d7c152680a7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 93ea0ec2 by Sebastian Graf at 2020-09-29T11:10:02+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,38 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HsLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HsLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HsLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap} + | isIdHsWrapper wrap + = ASSERT2(idType x `eqType` idType y, ppr x <+> ppr (idType x) <+> ppr y <+> ppr (idType y)) + Just $ PmLet x (Var y) + | otherwise + = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +480,41 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +after type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". +We make sure that there is no additional polymorphism in the way by only +picking up exports that are a simple renaming substitutions. That is the case +when their 'abe_wrap'per 'isIdHsWrapper'. We capture the renamings with +auxiliary 'PmLet's. Ultimately we'll hit those renamed 'FunBind's, though, +which is the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93ea0ec2d2c5be01093a6c0acf7cdb738982a09e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93ea0ec2d2c5be01093a6c0acf7cdb738982a09e You're receiving 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 29 09:37:56 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Tue, 29 Sep 2020 05:37:56 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f73007451647_80b3f848dbae3d8152761da@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: ac47a507 by Daniel Rogozin at 2020-09-29T12:37:37+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 11 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/module/mod132.stderr - testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below. +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That makes error messages more precise. +Previously, such errors contained only the info that a given value was +out of scope. We promote the namespace of RdrName and look up after that +(see the functions promotedRdrName and lookup_promoted). + +In particular, we have the following error message + • Type constructor 'Int' used where a value identifier was expected + +when the user writes the following term + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion]. + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -768,6 +768,16 @@ tc_infer_id id_name | otherwise -> nonBidirectionalErr id_name + ATyVar name _ + -> failWithTc $ + text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + + ATcTyCon ty_con + -> failWithTc $ + text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName ty_con)) + _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where @@ -1140,4 +1150,3 @@ addExprCtxt e thing_inside exprCtxt :: HsExpr GhcRn -> SDoc exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) - ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName mkClsOccFS = mkOccNameFS clsName -- demoteOccName lowers the Namespace of OccName. --- see Note [Demotion] +-- See Note [Demotion]. demoteOccName :: OccName -> Maybe OccName demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName. +-- See Note [Promotion]. +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName. +-- See Note [Promotion] in GHC.Rename.Env. +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/module/mod132.stderr ===================================== @@ -1,4 +1,5 @@ mod132.hs:6:7: error: - • Data constructor not in scope: Foo - • Perhaps you meant variable ‘foo’ (line 6) + Type constructor ‘Foo’ used where a value identifier was expected + In the expression: Foo + In an equation for ‘foo’: foo = Foo ===================================== testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr ===================================== @@ -1,3 +1,6 @@ -RnStaticPointersFail02.hs:5:12: error: - Data constructor not in scope: T +RnStaticPointersFail02.hs:5:12: +Type constructor ‘T’ used where a value identifier was expected +In the body of a static form: T + In the expression: static T + In an equation for ‘f’: f = static T ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Illegal term-level use of the type variable ‘a’ + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac47a50782ec10161c36ae032dd155f8a81c6a95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac47a50782ec10161c36ae032dd155f8a81c6a95 You're receiving 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 29 10:07:24 2020 From: gitlab at gitlab.haskell.org (Danya Rogozin) Date: Tue, 29 Sep 2020 06:07:24 -0400 Subject: [Git][ghc/ghc][wip/ghc-18740-lookup-update] Fall back to types when looking up data constructors (#18740) Message-ID: <5f73075c17972_80b3f84a049520015281586@gitlab.haskell.org.mail> Danya Rogozin pushed to branch wip/ghc-18740-lookup-update at Glasgow Haskell Compiler / GHC Commits: d79d03b6 by Daniel Rogozin at 2020-09-29T13:07:06+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: Type constructor 'Int' used where a value identifier was expected We also do this for type variables. - - - - - 12 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/module/mod132.stderr - testsuite/tests/module/mod147.stderr - testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr - + testsuite/tests/rename/should_fail/T18740a.hs - + testsuite/tests/rename/should_fail/T18740a.stderr - + testsuite/tests/rename/should_fail/T18740b.hs - + testsuite/tests/rename/should_fail/T18740b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -5,7 +5,7 @@ GHC.Rename.Env contains functions which convert RdrNames into Names. -} -{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-} +{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns, TypeApplications #-} module GHC.Rename.Env ( newTopSrcBinder, @@ -1005,6 +1005,14 @@ lookup_demoted rdr_name , text "instead of" , quotes (ppr name) <> dot ] +-- See Note [Promotion] below. +lookup_promoted :: RdrName -> RnM (Maybe Name) +lookup_promoted rdr_name + | Just promoted_rdr <- promoteRdrName rdr_name + = lookupOccRn_maybe promoted_rdr + | otherwise + = return Nothing + badVarInType :: RdrName -> RnM Name badVarInType rdr_name = do { addErr (text "Illegal promoted term variable in a type:" @@ -1040,6 +1048,23 @@ its namespace to DataName and do a second lookup. The final result (after the renamer) will be: HsTyVar ("Zero", DataName) + +Note [Promotion] +~~~~~~~~~~~~~~~ +When the user mentions a type constructor or a type variable in a +term-level context, then we report that a value identifier was expected +instead of a type-level one. That makes error messages more precise. +Previously, such errors contained only the info that a given value was +out of scope. We promote the namespace of RdrName and look up after that +(see the functions promotedRdrName and lookup_promoted). + +In particular, we have the following error message + • Type constructor 'Int' used where a value identifier was expected + +when the user writes the following term + + id Int + -} lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName @@ -1054,14 +1079,19 @@ lookupOccRn_maybe = lookupOccRnX_maybe lookupGlobalOccRn_maybe id lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name])) -lookupOccRn_overloaded overload_ok - = lookupOccRnX_maybe global_lookup Left - where - global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) - global_lookup n = - runMaybeT . msum . map MaybeT $ - [ lookupGlobalOccRn_overloaded overload_ok n - , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] +lookupOccRn_overloaded overload_ok rdr_name + = do { mb_name <- lookupOccRnX_maybe global_lookup Left rdr_name + ; case mb_name of + Nothing -> fmap @Maybe Left <$> lookup_promoted rdr_name + -- See Note [Promotion]. + p -> return p } + + where + global_lookup :: RdrName -> RnM (Maybe (Either Name [Name])) + global_lookup n = + runMaybeT . msum . map MaybeT $ + [ lookupGlobalOccRn_overloaded overload_ok n + , fmap Left . listToMaybe <$> lookupQualifiedNameGHCi n ] ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -768,6 +768,16 @@ tc_infer_id id_name | otherwise -> nonBidirectionalErr id_name + ATyVar name _ + -> failWithTc $ + text "Illegal term-level use of the type variable" + <+> quotes (ppr name) + + ATcTyCon ty_con + -> failWithTc $ + text "Illegal term-level use of the type constructor" + <+> quotes (ppr (tyConName ty_con)) + _ -> failWithTc $ ppr thing <+> text "used where a value identifier was expected" } where @@ -1140,4 +1150,3 @@ addExprCtxt e thing_inside exprCtxt :: HsExpr GhcRn -> SDoc exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) - ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Types.Name.Occurrence ( mkDFunOcc, setOccNameSpace, demoteOccName, + promoteOccName, HasOccName(..), -- ** Derived 'OccName's @@ -215,6 +216,14 @@ demoteNameSpace DataName = Nothing demoteNameSpace TvName = Nothing demoteNameSpace TcClsName = Just DataName +-- promoteNameSpace promotes the NameSpace as follows. +-- See Note [Promotion] in GHC.Rename.Env +promoteNameSpace :: NameSpace -> Maybe NameSpace +promoteNameSpace DataName = Just TcClsName +promoteNameSpace VarName = Just TvName +promoteNameSpace TcClsName = Nothing +promoteNameSpace TvName = Nothing + {- ************************************************************************ * * @@ -336,12 +345,19 @@ mkClsOccFS :: FastString -> OccName mkClsOccFS = mkOccNameFS clsName -- demoteOccName lowers the Namespace of OccName. --- see Note [Demotion] +-- See Note [Demotion]. demoteOccName :: OccName -> Maybe OccName demoteOccName (OccName space name) = do space' <- demoteNameSpace space return $ OccName space' name +-- promoteOccName promotes the NameSpace of OccName. +-- See Note [Promotion]. +promoteOccName :: OccName -> Maybe OccName +promoteOccName (OccName space name) = do + space' <- promoteNameSpace space + return $ OccName space' name + -- Name spaces are related if there is a chance to mean the one when one writes -- the other, i.e. variables <-> data constructors and type variables <-> type constructors nameSpacesRelated :: NameSpace -> NameSpace -> Bool ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -32,7 +32,7 @@ module GHC.Types.Name.Reader ( nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, + rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, @@ -179,13 +179,21 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc -- demoteRdrName lowers the NameSpace of RdrName. --- see Note [Demotion] in GHC.Types.Name.Occurrence +-- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ) demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +-- promoteRdrName promotes the NameSpace of RdrName. +-- See Note [Promotion] in GHC.Rename.Env. +promoteRdrName :: RdrName -> Maybe RdrName +promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ) +promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ) +promoteRdrName (Orig _ _) = Nothing +promoteRdrName (Exact _) = Nothing + -- These two are the basic constructors mkRdrUnqual :: OccName -> RdrName mkRdrUnqual occ = Unqual occ ===================================== testsuite/tests/module/mod132.stderr ===================================== @@ -1,4 +1,5 @@ mod132.hs:6:7: error: - • Data constructor not in scope: Foo - • Perhaps you meant variable ‘foo’ (line 6) + Type constructor ‘Foo’ used where a value identifier was expected + In the expression: Foo + In an equation for ‘foo’: foo = Foo ===================================== testsuite/tests/module/mod147.stderr ===================================== @@ -1,2 +1,5 @@ -mod147.hs:6:5: error: Data constructor not in scope: D :: t0 -> t +mod147.hs:6:5: + Type constructor 'D' used where a value identifier was expected + In the expression: D 4 + In an equation for 'x': x = D 4 ===================================== testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr ===================================== @@ -1,3 +1,6 @@ -RnStaticPointersFail02.hs:5:12: error: - Data constructor not in scope: T +RnStaticPointersFail02.hs:5:12: +Type constructor ‘T’ used where a value identifier was expected +In the body of a static form: T + In the expression: static T + In an equation for ‘f’: f = static T ===================================== testsuite/tests/rename/should_fail/T18740a.hs ===================================== @@ -0,0 +1,3 @@ +module T18740a where + +x = Int ===================================== testsuite/tests/rename/should_fail/T18740a.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740a.hs:3:5: error: + • Type constructor ‘Int’ used where a value identifier was expected + • In the expression: Int + In an equation for ‘x’: x = Int ===================================== testsuite/tests/rename/should_fail/T18740b.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module T18740b where + +import Data.Proxy + +f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/T18740b.stderr ===================================== @@ -0,0 +1,5 @@ + +T18740b.hs:6:24: error: + • Illegal term-level use of the type variable ‘a’ + • In the expression: a + In an equation for ‘f’: f (Proxy :: Proxy a) = a ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -156,3 +156,5 @@ test('T17593', normal, compile_fail, ['']) test('T18145', normal, compile_fail, ['']) test('T18240a', normal, compile_fail, ['']) test('T18240b', normal, compile_fail, ['']) +test('T18740a', normal, compile_fail, ['']) +test('T18740b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d79d03b6dd90bf12a98edd08a9080ce8f99c5ed6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d79d03b6dd90bf12a98edd08a9080ce8f99c5ed6 You're receiving 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 29 11:33:23 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 07:33:23 -0400 Subject: [Git][ghc/ghc][wip/T18626] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f731b833707b_80b3f8497e5b31015291282@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18626 at Glasgow Haskell Compiler / GHC Commits: 88197973 by Sebastian Graf at 2020-09-29T13:33:15+02:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,39 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HsLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HsLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = [] + , abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HsLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap} + | isIdHsWrapper wrap + = ASSERT2(idType x `eqType` idType y, ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y)) + Just $ PmLet x (Var y) + | otherwise + = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +481,43 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +Nfter type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". + +We make sure that there is no polymorphism in the way by checking that there +are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about + at y :: forall a. Eq a => ...@) and that the exports carry no 'HsWrapper's. In +this case, the exports are a simple renaming substitution that we can capture +with 'PmLet'. Ultimately we'll hit those renamed 'FunBind's, though, which is +the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8819797310092d120eeaf05310e7e01a800b5d7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8819797310092d120eeaf05310e7e01a800b5d7d You're receiving 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 29 13:08:59 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 29 Sep 2020 09:08:59 -0400 Subject: [Git][ghc/ghc][wip/andreask/winio_atomics] 19 commits: Remove unused ThBrackCtxt and ResSigCtxt Message-ID: <5f7331eb43cf4_80b11559eb4152995e2@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC Commits: 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 417d9ea5 by Andreas Klebinger at 2020-09-29T15:07:15+02:00 Rename atomic exchange, add cas primop - - - - - 18 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e99acb06614e2560dc2a90fdcb26b0fd45d12ab...417d9ea5ef2f7b4d2ef2e7ac127717b6aa84ce51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e99acb06614e2560dc2a90fdcb26b0fd45d12ab...417d9ea5ef2f7b4d2ef2e7ac127717b6aa84ce51 You're receiving 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 29 13:24:47 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 09:24:47 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f73359f8c717_80b3f84862c8144153018c6@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: c5cd5907 by Sebastian Graf at 2020-09-29T15:23:23+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Local let-bound + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -258,9 +257,11 @@ cprFix :: TopLevelFlag cprFix top_lvl env orig_pairs = loop 1 initial_pairs where - bot_sig = mkCprSig 0 botCpr + init_sig id + | isJust (cprDataStructureUnfolding_maybe id) = topCprSig + | otherwise = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] + initial_pairs | ae_virgin env = [(setIdCprInfo id (init_sig id), rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs -- The fixed-point varies the idCprInfo field of the binders, and terminates if that @@ -289,8 +290,7 @@ cprFix top_lvl env orig_pairs my_downRhs env (id,rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +299,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs', env) + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +314,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendAnalEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +328,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -645,9 +655,9 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] +Note [CPR for data structures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Long static data structures (whether top-level or not) like @@ -655,7 +665,7 @@ Long static data structures (whether top-level or not) like xs1 = x2 : xs2 xs2 = x3 : xs3 -should not get CPR signatures, because they +should not get CPR signatures (#18154), 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) @@ -666,25 +676,34 @@ should not get CPR signatures, because they But we can't just stop giving DataCon application bindings the CPR property, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +0 bindings via 'cprDataStructureUnfolding_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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). +But just testing for existence of 'cprDataStructureUnfolding_maybe' is too +specific! KindRep bindings are NOINLINE (see the noinline wrinkle in +Note [Grand plan for Typeable]), so they don't have an unfolding. +But they also shouldn't have a CPR signature for similar reasons as they are +marked NOINLINE. Generally, NOINLINE data structures should not have CPR. +In conclusion, in 'cprAnalBind' we don't add a CPR signature if it's binding a +data structure, regardless of having an unfolding or not. That's the case when + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +That's what 'isDataStructure' checks. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5cd5907c76fe7e24c58ca3b537ecd3315bf1e5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5cd5907c76fe7e24c58ca3b537ecd3315bf1e5f You're receiving 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 29 13:59:59 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 09:59:59 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f733ddf89b11_80b3f848bc12eac153085f6@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: 20de6d07 by Sebastian Graf at 2020-09-29T15:59:41+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -258,25 +257,26 @@ cprFix :: TopLevelFlag cprFix top_lvl env orig_pairs = loop 1 initial_pairs where - bot_sig = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] - | otherwise = orig_pairs + initial_pairs | ae_virgin env = [(setIdCprInfo id (mkCprSig 0 botCpr), rhs) + | (id, rhs) <- orig_pairs + -- See Note [CPR for data structures] + , isDataStructure id rhs ] + | otherwise = filter (uncurry isDataStructure) orig_pairs -- The fixed-point varies the idCprInfo field of the binders, and terminates if that -- annotation does not change any more. loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) loop n pairs - | found_fixpoint = (final_anal_env, pairs') + | found_fixpoint = (env', pairs') | otherwise = loop (n+1) pairs' where found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') + (env', pairs') = step first_round pairs - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + step :: Bool -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step first_round pairs = (env', pairs') where -- In all but the first iteration, delete the virgin flag start_env | first_round = env @@ -284,13 +284,12 @@ cprFix top_lvl env orig_pairs start = extendAnalEnvs start_env (map fst pairs) - (_, pairs') = mapAccumL my_downRhs start pairs + (env', pairs') = mapAccumL my_downRhs start pairs my_downRhs env (id,rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +298,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +313,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendAnalEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +327,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -645,17 +654,17 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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) @@ -663,28 +672,40 @@ should not get CPR signatures, because they * 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, +Hence we don't analyse or annotate data structures in 'cprAnalBind', which has +a special case for the 'isDataStructure' case, which is triggered for bindings +which satisfy + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +instead we keep on cprAnal'ing through *expandable* unfoldings for these data +structure bindings via 'cprDataStructureUnfolding_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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20de6d07328a39b6dbc5a36abf6007b32f827d6a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20de6d07328a39b6dbc5a36abf6007b32f827d6a You're receiving 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 29 14:10:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 10:10:45 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Cabal, hsc2hs, directory, process submodules Message-ID: <5f73406555de4_80b3f84427e0b481531175f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 18195e13 by Ben Gamari at 2020-09-29T10:10:37-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - 7 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -76,7 +76,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 9cacd5d465d5797e4935d1aa6ae6a71488a03938 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18195e136495efcc4bde897aaf789cb45da2874b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18195e136495efcc4bde897aaf789cb45da2874b You're receiving 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 29 14:37:47 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 10:37:47 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f7346bb49802_80b3f8496313aa8153202be@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: bd35991f by Sebastian Graf at 2020-09-29T16:37:39+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -258,25 +257,26 @@ cprFix :: TopLevelFlag cprFix top_lvl env orig_pairs = loop 1 initial_pairs where - bot_sig = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] - | otherwise = orig_pairs + initial_pairs | ae_virgin env = [(setIdCprInfo id (mkCprSig 0 botCpr), rhs) + | (id, rhs) <- orig_pairs + -- See Note [CPR for data structures] + , isDataStructure id rhs ] + | otherwise = filter (uncurry isDataStructure) orig_pairs -- The fixed-point varies the idCprInfo field of the binders, and terminates if that -- annotation does not change any more. loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) loop n pairs - | found_fixpoint = (final_anal_env, pairs') + | found_fixpoint = (env', pairs') | otherwise = loop (n+1) pairs' where found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') + (env', pairs') = step first_round pairs - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + step :: Bool -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step first_round pairs = (env', pairs') where -- In all but the first iteration, delete the virgin flag start_env | first_round = env @@ -284,13 +284,12 @@ cprFix top_lvl env orig_pairs start = extendAnalEnvs start_env (map fst pairs) - (_, pairs') = mapAccumL my_downRhs start pairs + (env', pairs') = mapAccumL my_downRhs start pairs my_downRhs env (id,rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +298,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +313,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendAnalEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +327,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -645,17 +654,17 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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) @@ -663,28 +672,52 @@ should not get CPR signatures, because they * 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, +Hence we don't analyse or annotate data structures in 'cprAnalBind'. There is +a special case for the 'isDataStructure' case, triggered for bindings which +satisfy + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +instead we keep on cprAnal'ing through expandable unfoldings (see for these data +structure bindings via 'cprDataStructureUnfolding_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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. + +It's also worth pointing out how ad-hoc this is: If we instead had + + f1 x = x:[] + f2 x = x : f1 x + f3 x = x : f2 x + ... + +we still give every function an every deepening CPR signature. But it's very +uncommon to find code like this, whereas the long static data structures from +the beginning of this Note are very common because of GHC's strategy of ANF'ing +data structure RHSs. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd35991f1b1b9149ded1e3b6397dce35f046052b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd35991f1b1b9149ded1e3b6397dce35f046052b You're receiving 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 29 14:49:59 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 29 Sep 2020 10:49:59 -0400 Subject: [Git][ghc/ghc][wip/andreask/allocationArea] 91 commits: Added explicit fixity to (~). Message-ID: <5f7349979b51c_80bd87ac14153259f3@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/allocationArea at Glasgow Haskell Compiler / GHC Commits: 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 30714844 by Andreas Klebinger at 2020-09-29T10:49:56-04:00 Increase -A default to 4MB. This gives a small increase in performance under most circumstances. For single threaded GC the improvement is on the order of 1-2%. For multi threaded GC the results are quite noisy but seem to fall into the same ballpark. Fixes #16499 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - aclocal.m4 - 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/Utils.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Dwarf/Types.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/289c151f405f39358030e1f4b1f757fb157c059f...30714844f51fa26937057d639be3c392bdfc7c7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/289c151f405f39358030e1f4b1f757fb157c059f...30714844f51fa26937057d639be3c392bdfc7c7b You're receiving 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 29 15:02:49 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 11:02:49 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f734c996115a_80b74f488415326759@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: f98701f5 by Sebastian Graf at 2020-09-29T17:02:42+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -258,25 +257,26 @@ cprFix :: TopLevelFlag cprFix top_lvl env orig_pairs = loop 1 initial_pairs where - bot_sig = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] - | otherwise = orig_pairs + initial_pairs | ae_virgin env = [(setIdCprInfo id (mkCprSig 0 botCpr), rhs) + | (id, rhs) <- orig_pairs + -- See Note [CPR for data structures] + , isDataStructure id rhs ] + | otherwise = filter (uncurry isDataStructure) orig_pairs -- The fixed-point varies the idCprInfo field of the binders, and terminates if that -- annotation does not change any more. loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) loop n pairs - | found_fixpoint = (final_anal_env, pairs') + | found_fixpoint = (env', pairs') | otherwise = loop (n+1) pairs' where found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') + (env', pairs') = step first_round pairs - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + step :: Bool -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step first_round pairs = (env', pairs') where -- In all but the first iteration, delete the virgin flag start_env | first_round = env @@ -284,13 +284,12 @@ cprFix top_lvl env orig_pairs start = extendAnalEnvs start_env (map fst pairs) - (_, pairs') = mapAccumL my_downRhs start pairs + (env', pairs') = mapAccumL my_downRhs start pairs my_downRhs env (id,rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +298,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +313,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendAnalEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +327,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -645,17 +654,17 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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) @@ -663,28 +672,53 @@ should not get CPR signatures, because they * 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, +Hence we don't analyse or annotate data structures in 'cprAnalBind'. There is +a special case for the 'isDataStructure' case, triggered for bindings which +satisfy + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +instead we keep on cprAnal'ing through expandable unfoldings +(see Note [exprIsExpandable] in "GHC.Core.Utils") for these data structure +bindings via 'cprDataStructureUnfolding_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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. + +It's also worth pointing out how ad-hoc this is: If we instead had + + f1 x = x:[] + f2 x = x : f1 x + f3 x = x : f2 x + ... + +we still give every function an every deepening CPR signature. But it's very +uncommon to find code like this, whereas the long static data structures from +the beginning of this Note are very common because of GHC's strategy of ANF'ing +data structure RHSs. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f98701f53575ede3c651cd8127769c69d5b00e77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f98701f53575ede3c651cd8127769c69d5b00e77 You're receiving 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 29 15:30:42 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 29 Sep 2020 11:30:42 -0400 Subject: [Git][ghc/ghc][wip/andreask/winio_atomics] WinIO: Small changes related to atomic request swaps. Message-ID: <5f735322d742c_80b3f848bd330ac15332859@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC Commits: bbacca45 by Andreas Klebinger at 2020-09-29T17:28:46+02:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - libraries/base/GHC/Event/Internal.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Ptr.hs - libraries/ghc-prim/changelog.md - testsuite/tests/codeGen/should_compile/cg011.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/codeGen/should_run/cas_int.hs - + testsuite/tests/codeGen/should_run/cas_int.stdout - testsuite/tests/codeGen/should_run/cgrun080.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2527,18 +2527,40 @@ primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp with has_side_effects = True can_fail = True -primop InterlockedExchange_Addr "interlockedExchangeAddr#" GenPrimOp +primop InterlockedExchange_Addr "atomicExchangeAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) {The atomic exchange operation. Atomically exchanges the value at the first address with the Addr# given as second argument. Implies a read barrier.} with has_side_effects = True -primop InterlockedExchange_Int "interlockedExchangeInt#" GenPrimOp +primop InterlockedExchange_Int "atomicExchangeInt#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int# #) {The atomic exchange operation. Atomically exchanges the value at the address with the given value. Returns the old value. Implies a read barrier.} with has_side_effects = True +primop AtomicCompareExchange_Int "atomicCasInt#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> (# State# s, Int# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasInt# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + +primop AtomicCompareExchange_Addr "atomicCasAddr#" GenPrimOp + Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasAddr# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + ------------------------------------------------------------------------ section "Mutable variables" {Operations on MutVar\#s.} ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2561,6 +2561,8 @@ genCCall' config is32Bit (PrimTarget (MO_Xchg width)) [dst] [addr, value] _ -- Copy the value into the target register, perform the exchange. let code = toOL [ MOV format (OpReg newval) (OpReg dst_r) + -- On X86 xchg implies a lock prefix if we use a memory argument. + -- so this is atomic. , XCHG format (OpAddr amode) dst_r ] return $ addr_code `appOL` newval_code `appOL` code ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -850,6 +850,10 @@ emitPrimOp dflags primop = case primop of emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] InterlockedExchange_Int -> \[src, value] -> opIntoRegs $ \[res] -> emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] + AtomicCompareExchange_Int -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] + AtomicCompareExchange_Addr -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] -- SIMD primops (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do ===================================== libraries/base/GHC/Event/Internal.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module GHC.Event.Internal ( @@ -13,6 +15,9 @@ module GHC.Event.Internal , module GHC.Event.Internal.Types -- * Helpers , throwErrnoIfMinus1NoRetry + + -- Atomic ptr exchange for WinIO + , exchangePtr ) where import Foreign.C.Error (eINTR, getErrno, throwErrno) @@ -21,6 +26,8 @@ import GHC.Base import GHC.Num (Num(..)) import GHC.Event.Internal.Types +import GHC.Ptr (Ptr(..)) + -- | Event notification backend. data Backend = forall a. Backend { _beState :: !a @@ -95,3 +102,12 @@ throwErrnoIfMinus1NoRetry loc f = do err <- getErrno if err == eINTR then return 0 else throwErrno loc else return res + +{-# INLINE exchangePtr #-} +-- | @exchangePtr pptr x@ swaps the pointer pointed to by @pptr@ with the value +-- @x@, returning the old value. +exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a) +exchangePtr (Ptr dst) (Ptr val) = + IO $ \s -> + case (atomicExchangeAddr# dst val s) of + (# s2, old_val #) -> (# s2, Ptr old_val #) \ No newline at end of file ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -306,10 +306,6 @@ foreign import ccall safe "completeSynchronousRequest" cdOffset :: Int cdOffset = #{const __builtin_offsetof (HASKELL_OVERLAPPED, hoData)} --- | Terminator symbol for IOCP request -nullReq :: Ptr (Ptr a) -nullReq = castPtr $ unsafePerformIO $ new $ (nullPtr :: Ptr ()) - -- I don't expect a lot of events, so a simple linked lists should be enough. type EventElements = [(Event, HandleData)] data EventData = EventData { evtTopLevel :: !Event, evtElems :: !EventElements } @@ -667,7 +663,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- the pointer. debugIO $ "## Waiting for cancellation record... " _ <- FFI.getOverlappedResult h lpol True - oldDataPtr <- exchangePtr ptr_lpol nullReq + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr when (oldDataPtr == cdData) $ do reqs <- removeRequest debugIO $ "-1.. " ++ show reqs ++ " requests queued after error." @@ -1039,7 +1035,7 @@ processCompletion Manager{..} n delay = do ++ " offset: " ++ show cdOffset ++ " cdData: " ++ show cdDataCheck ++ " at idx " ++ show idx - oldDataPtr <- exchangePtr ptr_lpol nullReq :: IO (Ptr CompletionData) + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr :: IO (Ptr CompletionData) debugIO $ ":: oldDataPtr " ++ show oldDataPtr when (oldDataPtr /= nullPtr) $ do debugIO $ "exchanged: " ++ show oldDataPtr ===================================== libraries/base/GHC/Ptr.hs ===================================== @@ -25,8 +25,6 @@ module GHC.Ptr ( -- * Unsafe functions castFunPtrToPtr, castPtrToFunPtr, - -- * Atomic operations - exchangePtr ) where import GHC.Base @@ -164,16 +162,6 @@ castFunPtrToPtr (FunPtr addr) = Ptr addr castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------- --- Atomic operations for Ptr - -{-# INLINE exchangePtr #-} -exchangePtr :: Ptr (Ptr a) -> Ptr b -> IO (Ptr c) -exchangePtr (Ptr dst) (Ptr val) = - IO $ \s -> - case (interlockedExchangeAddr# dst val s) of - (# s2, old_val #) -> (# s2, Ptr old_val #) - ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -21,8 +21,8 @@ - Add primops for atomic exchange: - interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) - interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) + atomicExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + atomicExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) - Add an explicit fixity for `(~)` and `(~~)`: ===================================== testsuite/tests/codeGen/should_compile/cg011.hs ===================================== @@ -1,11 +1,11 @@ {-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} --- Tests compilation for interlockedExchange primop. +-- Tests compilation for atomic exchange primop. module M where -import GHC.Exts (interlockedExchangeInt#, Int#, Addr#, State# ) +import GHC.Exts (atomicExchangeInt#, Int#, Addr#, State# ) swap :: Addr# -> Int# -> State# s -> (# #) -swap ptr val s = case (interlockedExchangeInt# ptr val s) of +swap ptr val s = case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# #) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -90,6 +90,7 @@ test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], comp test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('cgrun079', normal, compile_and_run, ['']) test('cgrun080', normal, compile_and_run, ['']) +test('cas_int', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/cas_int.hs ===================================== @@ -0,0 +1,83 @@ +{-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} +{-# LANGUAGE CPP, MagicHash, BlockArguments, ScopedTypeVariables #-} + +-- Test the atomic exchange primop. + +-- We initialize a value with 1, and then perform exchanges on it +-- with two different values. At the end all the values should still +-- be present. + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Control.Monad +import Control.Concurrent +import Foreign.Marshal.Alloc +import Foreign.Storable +import Data.List (sort) + +import GHC.Exts +import GHC.Types +import GHC.Ptr + +#include "MachDeps.h" + +main = do + alloca $ \(ptr_p :: Ptr (Ptr Int)) -> do + alloca $ \(ptr_i :: Ptr Int) -> do + alloca $ \(ptr_j :: Ptr Int) -> do + poke ptr_i (1 :: Int) + poke ptr_j (2 :: Int) + + --expected to swap + res_i <- cas ptr_i 1 3 :: IO Int + -- expected to fail + res_j <- cas ptr_j 1 4 :: IO Int + + putStrLn "Returned results:" + --(1,2) + print (res_i, res_j) + + i <-peek ptr_i + j <-peek ptr_j + + putStrLn "Stored results:" + --(3,2) + print (i,j) + -- let x = 0 + -- exchangePtr ptr_p ptr_j + + -- p <- peek ptr_p + -- poke p 99 + -- -- poke ptr_j 2 + + -- p1 <- peek ptr_i + -- p2 <- peek ptr_j + -- print (x,p1,p2) + + + -- w1 <- newEmptyMVar :: IO (MVar Int) + -- forkIO $ do + -- v <- swapN 50000 2 ptr_i + -- putMVar w1 v + + -- v2 <- swapN 50000 3 ptr_i + -- v1 <- takeMVar w1 + -- v0 <- peek ptr_i + -- -- Should be [1,2,3] + -- print $ sort [v0,v1,v2] + +-- swapN :: Int -> Int -> Ptr Int -> IO Int +-- swapN 0 val ptr = return val +-- swapN n val ptr = do +-- val' <- swap ptr val +-- swapN (n-1) val' ptr + + +cas :: Ptr Int -> Int -> Int -> IO Int +cas (Ptr ptr) (I# expected) (I# desired)= do + IO $ \s -> case (atomicCasInt# ptr expected desired s) of + (# s2, old_val #) -> (# s2, I# old_val #) ===================================== testsuite/tests/codeGen/should_run/cas_int.stdout ===================================== @@ -0,0 +1,4 @@ +Returned results: +(1,2) +Stored results: +(3,2) ===================================== testsuite/tests/codeGen/should_run/cgrun080.hs ===================================== @@ -46,6 +46,6 @@ swapN n val ptr = do swap :: Ptr Int -> Int -> IO Int swap (Ptr ptr) (I# val) = do - IO $ \s -> case (interlockedExchangeInt# ptr val s) of + IO $ \s -> case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# s2, I# old_val #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbacca45cbba68d5c6423b60db3c6a2d1d0d0f39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bbacca45cbba68d5c6423b60db3c6a2d1d0d0f39 You're receiving 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 29 15:32:33 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 29 Sep 2020 11:32:33 -0400 Subject: [Git][ghc/ghc][wip/andreask/winio_atomics] WinIO: Small changes related to atomic request swaps. Message-ID: <5f735391b4bcd_80b3f84869db67015334340@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC Commits: 1ee84b85 by Andreas Klebinger at 2020-09-29T17:31:27+02:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - libraries/base/GHC/Event/Internal.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Ptr.hs - libraries/ghc-prim/changelog.md - testsuite/tests/codeGen/should_compile/cg011.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/codeGen/should_run/cas_int.hs - + testsuite/tests/codeGen/should_run/cas_int.stdout - testsuite/tests/codeGen/should_run/cgrun080.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2527,18 +2527,40 @@ primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp with has_side_effects = True can_fail = True -primop InterlockedExchange_Addr "interlockedExchangeAddr#" GenPrimOp +primop InterlockedExchange_Addr "atomicExchangeAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) {The atomic exchange operation. Atomically exchanges the value at the first address with the Addr# given as second argument. Implies a read barrier.} with has_side_effects = True -primop InterlockedExchange_Int "interlockedExchangeInt#" GenPrimOp +primop InterlockedExchange_Int "atomicExchangeInt#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int# #) {The atomic exchange operation. Atomically exchanges the value at the address with the given value. Returns the old value. Implies a read barrier.} with has_side_effects = True +primop AtomicCompareExchange_Int "atomicCasInt#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> (# State# s, Int# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasInt# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + +primop AtomicCompareExchange_Addr "atomicCasAddr#" GenPrimOp + Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasAddr# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + ------------------------------------------------------------------------ section "Mutable variables" {Operations on MutVar\#s.} ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2561,6 +2561,8 @@ genCCall' config is32Bit (PrimTarget (MO_Xchg width)) [dst] [addr, value] _ -- Copy the value into the target register, perform the exchange. let code = toOL [ MOV format (OpReg newval) (OpReg dst_r) + -- On X86 xchg implies a lock prefix if we use a memory argument. + -- so this is atomic. , XCHG format (OpAddr amode) dst_r ] return $ addr_code `appOL` newval_code `appOL` code ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -850,6 +850,10 @@ emitPrimOp dflags primop = case primop of emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] InterlockedExchange_Int -> \[src, value] -> opIntoRegs $ \[res] -> emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] + AtomicCompareExchange_Int -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] + AtomicCompareExchange_Addr -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] -- SIMD primops (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do ===================================== libraries/base/GHC/Event/Internal.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module GHC.Event.Internal ( @@ -13,6 +15,9 @@ module GHC.Event.Internal , module GHC.Event.Internal.Types -- * Helpers , throwErrnoIfMinus1NoRetry + + -- Atomic ptr exchange for WinIO + , exchangePtr ) where import Foreign.C.Error (eINTR, getErrno, throwErrno) @@ -21,6 +26,8 @@ import GHC.Base import GHC.Num (Num(..)) import GHC.Event.Internal.Types +import GHC.Ptr (Ptr(..)) + -- | Event notification backend. data Backend = forall a. Backend { _beState :: !a @@ -95,3 +102,12 @@ throwErrnoIfMinus1NoRetry loc f = do err <- getErrno if err == eINTR then return 0 else throwErrno loc else return res + +{-# INLINE exchangePtr #-} +-- | @exchangePtr pptr x@ swaps the pointer pointed to by @pptr@ with the value +-- @x@, returning the old value. +exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a) +exchangePtr (Ptr dst) (Ptr val) = + IO $ \s -> + case (atomicExchangeAddr# dst val s) of + (# s2, old_val #) -> (# s2, Ptr old_val #) \ No newline at end of file ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -306,10 +306,6 @@ foreign import ccall safe "completeSynchronousRequest" cdOffset :: Int cdOffset = #{const __builtin_offsetof (HASKELL_OVERLAPPED, hoData)} --- | Terminator symbol for IOCP request -nullReq :: Ptr (Ptr a) -nullReq = castPtr $ unsafePerformIO $ new $ (nullPtr :: Ptr ()) - -- I don't expect a lot of events, so a simple linked lists should be enough. type EventElements = [(Event, HandleData)] data EventData = EventData { evtTopLevel :: !Event, evtElems :: !EventElements } @@ -667,7 +663,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- the pointer. debugIO $ "## Waiting for cancellation record... " _ <- FFI.getOverlappedResult h lpol True - oldDataPtr <- exchangePtr ptr_lpol nullReq + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr when (oldDataPtr == cdData) $ do reqs <- removeRequest debugIO $ "-1.. " ++ show reqs ++ " requests queued after error." @@ -1039,7 +1035,7 @@ processCompletion Manager{..} n delay = do ++ " offset: " ++ show cdOffset ++ " cdData: " ++ show cdDataCheck ++ " at idx " ++ show idx - oldDataPtr <- exchangePtr ptr_lpol nullReq :: IO (Ptr CompletionData) + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr :: IO (Ptr CompletionData) debugIO $ ":: oldDataPtr " ++ show oldDataPtr when (oldDataPtr /= nullPtr) $ do debugIO $ "exchanged: " ++ show oldDataPtr ===================================== libraries/base/GHC/Ptr.hs ===================================== @@ -25,8 +25,6 @@ module GHC.Ptr ( -- * Unsafe functions castFunPtrToPtr, castPtrToFunPtr, - -- * Atomic operations - exchangePtr ) where import GHC.Base @@ -164,16 +162,6 @@ castFunPtrToPtr (FunPtr addr) = Ptr addr castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------- --- Atomic operations for Ptr - -{-# INLINE exchangePtr #-} -exchangePtr :: Ptr (Ptr a) -> Ptr b -> IO (Ptr c) -exchangePtr (Ptr dst) (Ptr val) = - IO $ \s -> - case (interlockedExchangeAddr# dst val s) of - (# s2, old_val #) -> (# s2, Ptr old_val #) - ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -21,8 +21,8 @@ - Add primops for atomic exchange: - interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) - interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) + atomicExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + atomicExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) - Add an explicit fixity for `(~)` and `(~~)`: ===================================== testsuite/tests/codeGen/should_compile/cg011.hs ===================================== @@ -1,11 +1,11 @@ {-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} --- Tests compilation for interlockedExchange primop. +-- Tests compilation for atomic exchange primop. module M where -import GHC.Exts (interlockedExchangeInt#, Int#, Addr#, State# ) +import GHC.Exts (atomicExchangeInt#, Int#, Addr#, State# ) swap :: Addr# -> Int# -> State# s -> (# #) -swap ptr val s = case (interlockedExchangeInt# ptr val s) of +swap ptr val s = case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# #) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -90,6 +90,7 @@ test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], comp test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('cgrun079', normal, compile_and_run, ['']) test('cgrun080', normal, compile_and_run, ['']) +test('cas_int', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/cas_int.hs ===================================== @@ -0,0 +1,83 @@ +{-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} +{-# LANGUAGE CPP, MagicHash, BlockArguments, ScopedTypeVariables #-} + +-- Test the atomic exchange primop. + +-- We initialize a value with 1, and then perform exchanges on it +-- with two different values. At the end all the values should still +-- be present. + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Control.Monad +import Control.Concurrent +import Foreign.Marshal.Alloc +import Foreign.Storable +import Data.List (sort) + +import GHC.Exts +import GHC.Types +import GHC.Ptr + +#include "MachDeps.h" + +main = do + alloca $ \(ptr_p :: Ptr (Ptr Int)) -> do + alloca $ \(ptr_i :: Ptr Int) -> do + alloca $ \(ptr_j :: Ptr Int) -> do + poke ptr_i (1 :: Int) + poke ptr_j (2 :: Int) + + --expected to swap + res_i <- cas ptr_i 1 3 :: IO Int + -- expected to fail + res_j <- cas ptr_j 1 4 :: IO Int + + putStrLn "Returned results:" + --(1,2) + print (res_i, res_j) + + i <-peek ptr_i + j <-peek ptr_j + + putStrLn "Stored results:" + --(3,2) + print (i,j) + -- let x = 0 + -- exchangePtr ptr_p ptr_j + + -- p <- peek ptr_p + -- poke p 99 + -- -- poke ptr_j 2 + + -- p1 <- peek ptr_i + -- p2 <- peek ptr_j + -- print (x,p1,p2) + + + -- w1 <- newEmptyMVar :: IO (MVar Int) + -- forkIO $ do + -- v <- swapN 50000 2 ptr_i + -- putMVar w1 v + + -- v2 <- swapN 50000 3 ptr_i + -- v1 <- takeMVar w1 + -- v0 <- peek ptr_i + -- -- Should be [1,2,3] + -- print $ sort [v0,v1,v2] + +-- swapN :: Int -> Int -> Ptr Int -> IO Int +-- swapN 0 val ptr = return val +-- swapN n val ptr = do +-- val' <- swap ptr val +-- swapN (n-1) val' ptr + + +cas :: Ptr Int -> Int -> Int -> IO Int +cas (Ptr ptr) (I# expected) (I# desired)= do + IO $ \s -> case (atomicCasInt# ptr expected desired s) of + (# s2, old_val #) -> (# s2, I# old_val #) ===================================== testsuite/tests/codeGen/should_run/cas_int.stdout ===================================== @@ -0,0 +1,4 @@ +Returned results: +(1,2) +Stored results: +(3,2) ===================================== testsuite/tests/codeGen/should_run/cgrun080.hs ===================================== @@ -46,6 +46,6 @@ swapN n val ptr = do swap :: Ptr Int -> Int -> IO Int swap (Ptr ptr) (I# val) = do - IO $ \s -> case (interlockedExchangeInt# ptr val s) of + IO $ \s -> case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# s2, I# old_val #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ee84b859b5561f7b04bb7122a145da81ec064cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ee84b859b5561f7b04bb7122a145da81ec064cd You're receiving 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 29 15:34:23 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Tue, 29 Sep 2020 11:34:23 -0400 Subject: [Git][ghc/ghc][wip/andreask/winio_atomics] WinIO: Small changes related to atomic request swaps. Message-ID: <5f7353ffd767e_80b10e0157c153369ac@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC Commits: b21c3889 by Andreas Klebinger at 2020-09-29T17:34:11+02:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - libraries/base/GHC/Event/Internal.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Ptr.hs - libraries/ghc-prim/changelog.md - testsuite/tests/codeGen/should_compile/cg011.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/codeGen/should_run/cas_int.hs - + testsuite/tests/codeGen/should_run/cas_int.stdout - testsuite/tests/codeGen/should_run/cgrun080.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2527,18 +2527,40 @@ primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp with has_side_effects = True can_fail = True -primop InterlockedExchange_Addr "interlockedExchangeAddr#" GenPrimOp +primop InterlockedExchange_Addr "atomicExchangeAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) {The atomic exchange operation. Atomically exchanges the value at the first address with the Addr# given as second argument. Implies a read barrier.} with has_side_effects = True -primop InterlockedExchange_Int "interlockedExchangeInt#" GenPrimOp +primop InterlockedExchange_Int "atomicExchangeInt#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int# #) {The atomic exchange operation. Atomically exchanges the value at the address with the given value. Returns the old value. Implies a read barrier.} with has_side_effects = True +primop AtomicCompareExchange_Int "atomicCasInt#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> (# State# s, Int# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasInt# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + +primop AtomicCompareExchange_Addr "atomicCasAddr#" GenPrimOp + Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasAddr# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + ------------------------------------------------------------------------ section "Mutable variables" {Operations on MutVar\#s.} ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2561,6 +2561,8 @@ genCCall' config is32Bit (PrimTarget (MO_Xchg width)) [dst] [addr, value] _ -- Copy the value into the target register, perform the exchange. let code = toOL [ MOV format (OpReg newval) (OpReg dst_r) + -- On X86 xchg implies a lock prefix if we use a memory argument. + -- so this is atomic. , XCHG format (OpAddr amode) dst_r ] return $ addr_code `appOL` newval_code `appOL` code ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -850,6 +850,10 @@ emitPrimOp dflags primop = case primop of emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] InterlockedExchange_Int -> \[src, value] -> opIntoRegs $ \[res] -> emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] + AtomicCompareExchange_Int -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] + AtomicCompareExchange_Addr -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] -- SIMD primops (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do ===================================== libraries/base/GHC/Event/Internal.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module GHC.Event.Internal ( @@ -13,6 +15,9 @@ module GHC.Event.Internal , module GHC.Event.Internal.Types -- * Helpers , throwErrnoIfMinus1NoRetry + + -- Atomic ptr exchange for WinIO + , exchangePtr ) where import Foreign.C.Error (eINTR, getErrno, throwErrno) @@ -21,6 +26,8 @@ import GHC.Base import GHC.Num (Num(..)) import GHC.Event.Internal.Types +import GHC.Ptr (Ptr(..)) + -- | Event notification backend. data Backend = forall a. Backend { _beState :: !a @@ -95,3 +102,12 @@ throwErrnoIfMinus1NoRetry loc f = do err <- getErrno if err == eINTR then return 0 else throwErrno loc else return res + +{-# INLINE exchangePtr #-} +-- | @exchangePtr pptr x@ swaps the pointer pointed to by @pptr@ with the value +-- @x@, returning the old value. +exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a) +exchangePtr (Ptr dst) (Ptr val) = + IO $ \s -> + case (atomicExchangeAddr# dst val s) of + (# s2, old_val #) -> (# s2, Ptr old_val #) \ No newline at end of file ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -306,10 +306,6 @@ foreign import ccall safe "completeSynchronousRequest" cdOffset :: Int cdOffset = #{const __builtin_offsetof (HASKELL_OVERLAPPED, hoData)} --- | Terminator symbol for IOCP request -nullReq :: Ptr (Ptr a) -nullReq = castPtr $ unsafePerformIO $ new $ (nullPtr :: Ptr ()) - -- I don't expect a lot of events, so a simple linked lists should be enough. type EventElements = [(Event, HandleData)] data EventData = EventData { evtTopLevel :: !Event, evtElems :: !EventElements } @@ -667,7 +663,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- the pointer. debugIO $ "## Waiting for cancellation record... " _ <- FFI.getOverlappedResult h lpol True - oldDataPtr <- exchangePtr ptr_lpol nullReq + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr when (oldDataPtr == cdData) $ do reqs <- removeRequest debugIO $ "-1.. " ++ show reqs ++ " requests queued after error." @@ -1039,7 +1035,7 @@ processCompletion Manager{..} n delay = do ++ " offset: " ++ show cdOffset ++ " cdData: " ++ show cdDataCheck ++ " at idx " ++ show idx - oldDataPtr <- exchangePtr ptr_lpol nullReq :: IO (Ptr CompletionData) + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr :: IO (Ptr CompletionData) debugIO $ ":: oldDataPtr " ++ show oldDataPtr when (oldDataPtr /= nullPtr) $ do debugIO $ "exchanged: " ++ show oldDataPtr ===================================== libraries/base/GHC/Ptr.hs ===================================== @@ -25,8 +25,6 @@ module GHC.Ptr ( -- * Unsafe functions castFunPtrToPtr, castPtrToFunPtr, - -- * Atomic operations - exchangePtr ) where import GHC.Base @@ -164,16 +162,6 @@ castFunPtrToPtr (FunPtr addr) = Ptr addr castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------- --- Atomic operations for Ptr - -{-# INLINE exchangePtr #-} -exchangePtr :: Ptr (Ptr a) -> Ptr b -> IO (Ptr c) -exchangePtr (Ptr dst) (Ptr val) = - IO $ \s -> - case (interlockedExchangeAddr# dst val s) of - (# s2, old_val #) -> (# s2, Ptr old_val #) - ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -21,8 +21,8 @@ - Add primops for atomic exchange: - interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) - interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) + atomicExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + atomicExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) - Add an explicit fixity for `(~)` and `(~~)`: ===================================== testsuite/tests/codeGen/should_compile/cg011.hs ===================================== @@ -1,11 +1,11 @@ {-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} --- Tests compilation for interlockedExchange primop. +-- Tests compilation for atomic exchange primop. module M where -import GHC.Exts (interlockedExchangeInt#, Int#, Addr#, State# ) +import GHC.Exts (atomicExchangeInt#, Int#, Addr#, State# ) swap :: Addr# -> Int# -> State# s -> (# #) -swap ptr val s = case (interlockedExchangeInt# ptr val s) of +swap ptr val s = case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# #) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -90,6 +90,7 @@ test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], comp test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('cgrun079', normal, compile_and_run, ['']) test('cgrun080', normal, compile_and_run, ['']) +test('cas_int', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/cas_int.hs ===================================== @@ -0,0 +1,54 @@ +{-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} +{-# LANGUAGE CPP, MagicHash, BlockArguments, ScopedTypeVariables #-} + +-- Test the atomic exchange primop. + +-- We initialize a value with 1, and then perform exchanges on it +-- with two different values. At the end all the values should still +-- be present. + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Control.Monad +import Control.Concurrent +import Foreign.Marshal.Alloc +import Foreign.Storable +import Data.List (sort) + +import GHC.Exts +import GHC.Types +import GHC.Ptr + +#include "MachDeps.h" + +main = do + alloca $ \(ptr_p :: Ptr (Ptr Int)) -> do + alloca $ \(ptr_i :: Ptr Int) -> do + alloca $ \(ptr_j :: Ptr Int) -> do + poke ptr_i (1 :: Int) + poke ptr_j (2 :: Int) + + --expected to swap + res_i <- cas ptr_i 1 3 :: IO Int + -- expected to fail + res_j <- cas ptr_j 1 4 :: IO Int + + putStrLn "Returned results:" + --(1,2) + print (res_i, res_j) + + i <-peek ptr_i + j <-peek ptr_j + + putStrLn "Stored results:" + --(3,2) + print (i,j) + +cas :: Ptr Int -> Int -> Int -> IO Int +cas (Ptr ptr) (I# expected) (I# desired)= do + IO $ \s -> case (atomicCasInt# ptr expected desired s) of + (# s2, old_val #) -> (# s2, I# old_val #) ===================================== testsuite/tests/codeGen/should_run/cas_int.stdout ===================================== @@ -0,0 +1,4 @@ +Returned results: +(1,2) +Stored results: +(3,2) ===================================== testsuite/tests/codeGen/should_run/cgrun080.hs ===================================== @@ -46,6 +46,6 @@ swapN n val ptr = do swap :: Ptr Int -> Int -> IO Int swap (Ptr ptr) (I# val) = do - IO $ \s -> case (interlockedExchangeInt# ptr val s) of + IO $ \s -> case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# s2, I# old_val #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b21c38891e68cd21fe4ff29921ad845ae4e43c34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b21c38891e68cd21fe4ff29921ad845ae4e43c34 You're receiving 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 29 15:42:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 11:42:04 -0400 Subject: [Git][ghc/ghc][wip/backports] 7 commits: Bignum: refactor backend modules Message-ID: <5f7355cc4faa9_80b3f84688ce584153414c0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 6c98a930 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 74f3f581 by Sylvain Henry at 2020-09-28T08:37:29+02:00 Bignum: implement extended GCD (#18427) - - - - - ebcc0968 by Sylvain Henry at 2020-09-28T09:56:49+02:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - edfa896e by Arnaud Spiwack at 2020-09-29T11:41:25-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. (cherry picked from commit 2707c4eae4cf99e6da2709e128f560d91e468357) - - - - - a64ea9d0 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Disallow linear types in FFI (#18472) (cherry picked from commit 160fba4aa306c0649c72a6dcd7c98d9782a0e74b) - - - - - f8d8c343 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH (cherry picked from commit 83407ffc7acc00cc025b9f6ed063add9ab9f9bcc) - - - - - 90fe5cff by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. (cherry picked from commit e124f2a7d9a5932a4c2383fd3f9dd772b2059885) - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Match.hs - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/defer_type_errors.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/safe_haskell.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/typed_holes.rst - docs/users_guide/using-optimisation.rst - libraries/ghc-bignum/cbits/gmp_wrappers.c - libraries/ghc-bignum/ghc-bignum.cabal - + libraries/ghc-bignum/src/GHC/Num/Backend.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs → libraries/ghc-bignum/src/GHC/Num/Backend/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs → libraries/ghc-bignum/src/GHC/Num/Backend/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs → libraries/ghc-bignum/src/GHC/Num/Backend/Native.hs - + libraries/ghc-bignum/src/GHC/Num/Backend/Selected.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat.hs-boot - libraries/ghc-bignum/src/GHC/Num/Integer.hs - + libraries/ghc-bignum/src/GHC/Num/Integer.hs-boot - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - testsuite/tests/lib/integer/all.T - + testsuite/tests/lib/integer/gcdeInteger.hs - + testsuite/tests/lib/integer/gcdeInteger.stdout - testsuite/tests/lib/integer/integerGcdExt.hs - + testsuite/tests/linear/should_fail/LinearFFI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/409f18b00209b1d4c801fe4d282f1b302ded7105...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/409f18b00209b1d4c801fe4d282f1b302ded7105...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7 You're receiving 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 29 15:45:12 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 11:45:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18765 Message-ID: <5f7356889f213_80b3f84688ce58415342165@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18765 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18765 You're receiving 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 29 16:20:43 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 12:20:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18767 Message-ID: <5f735edbcd08_80b3f845612f8581535426d@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18767 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18767 You're receiving 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 29 16:24:39 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 12:24:39 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f735fc7d1937_80b3f849a2a368c153544b8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: 784ed0e2 by Sebastian Graf at 2020-09-29T18:23:53+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -258,25 +257,27 @@ cprFix :: TopLevelFlag cprFix top_lvl env orig_pairs = loop 1 initial_pairs where - bot_sig = mkCprSig 0 botCpr + init_sig id rhs + -- See Note [CPR for data structures] + | isDataStructure id rhs = topCprSig + | otherwise = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] + initial_pairs | ae_virgin env = [(setIdCprInfo id (init_sig id rhs), rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs -- The fixed-point varies the idCprInfo field of the binders, and terminates if that -- annotation does not change any more. loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) loop n pairs - | found_fixpoint = (final_anal_env, pairs') + | found_fixpoint = (env', pairs') | otherwise = loop (n+1) pairs' where found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') + (env', pairs') = step first_round pairs - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + step :: Bool -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step first_round pairs = (env', pairs') where -- In all but the first iteration, delete the virgin flag start_env | first_round = env @@ -284,13 +285,12 @@ cprFix top_lvl env orig_pairs start = extendAnalEnvs start_env (map fst pairs) - (_, pairs') = mapAccumL my_downRhs start pairs + (env', pairs') = mapAccumL my_downRhs start pairs my_downRhs env (id,rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +299,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +314,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendAnalEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +328,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -645,17 +655,17 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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) @@ -663,28 +673,53 @@ should not get CPR signatures, because they * 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, +Hence we don't analyse or annotate data structures in 'cprAnalBind'. There is +a special case for the 'isDataStructure' case, triggered for bindings which +satisfy + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +instead we keep on cprAnal'ing through expandable unfoldings +(see Note [exprIsExpandable] in "GHC.Core.Utils") for these data structure +bindings via 'cprDataStructureUnfolding_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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. + +It's also worth pointing out how ad-hoc this is: If we instead had + + f1 x = x:[] + f2 x = x : f1 x + f3 x = x : f2 x + ... + +we still give every function an every deepening CPR signature. But it's very +uncommon to find code like this, whereas the long static data structures from +the beginning of this Note are very common because of GHC's strategy of ANF'ing +data structure RHSs. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/784ed0e269786507f9d1936b5d1ab9972a911c18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/784ed0e269786507f9d1936b5d1ab9972a911c18 You're receiving 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 29 16:33:51 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 29 Sep 2020 12:33:51 -0400 Subject: [Git][ghc/ghc][wip/T18767] Pmc: Don't call exprType on type arguments (#18767) Message-ID: <5f7361ef5623c_80b3f849a2a368c1535966e@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18767 at Glasgow Haskell Compiler / GHC Commits: 7810d130 by Sebastian Graf at 2020-09-29T18:33:41+02:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 1 changed file: - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -62,6 +62,7 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Solver.Monad (InertSet, emptyInert) +import GHC.Tc.Utils.TcType (isStringTy) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -562,7 +563,7 @@ coreExprAsPmLit e = case collectArgs e of (Var x, args) | is_rebound_name x fromStringName -- See Note [Detecting overloaded literals with -XRebindableSyntax] - , s:_ <- filter (eqType stringTy . exprType) args + , s:_ <- filter (isStringTy . exprType) $ filter isValArg args -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings -> coreExprAsPmLit s >>= overloadPmLit (exprType e) -- These last two cases handle proper String literals View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7810d1307498e0ee2bf8f28e18220203cd775b2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7810d1307498e0ee2bf8f28e18220203cd775b2a You're receiving 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 29 16:38:50 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 29 Sep 2020 12:38:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T10709 Message-ID: <5f73631a196e8_80bf32b9c81536342@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/T10709 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T10709 You're receiving 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 29 16:40:02 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 12:40:02 -0400 Subject: [Git][ghc/ghc][ghc-8.8] Fix uninitialized field read in Linker.c Message-ID: <5f73636296667_80bd923abc1536513@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-8.8 at Glasgow Haskell Compiler / GHC Commits: 16f83b57 by Ömer Sinan Ağacan at 2020-09-29T12:39:48-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 (cherry picked from commit 08c1cb0f30770acbf366423f085f8ef92f7f6a06) - - - - - 1 changed file: - rts/Linker.c Changes: ===================================== rts/Linker.c ===================================== @@ -1238,23 +1238,6 @@ void freeObjectCode (ObjectCode *oc) stgFree(oc); } -/* ----------------------------------------------------------------------------- -* Sets the initial status of a fresh ObjectCode -*/ -static void setOcInitialStatus(ObjectCode* oc) { - /* If a target has requested the ObjectCode not to be resolved then - honor this requests. Usually this means the ObjectCode has not been - initialized and can't be. */ - if (oc->status == OBJECT_DONT_RESOLVE) - return; - - if (oc->archiveMemberName == NULL) { - oc->status = OBJECT_NEEDED; - } else { - oc->status = OBJECT_LOADED; - } -} - ObjectCode* mkOc( pathchar *path, char *image, int imageSize, bool mapped, char *archiveMemberName, int misalignment ) { @@ -1287,7 +1270,11 @@ mkOc( pathchar *path, char *image, int imageSize, oc->archiveMemberName = NULL; } - setOcInitialStatus( oc ); + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } oc->fileSize = imageSize; oc->symbols = NULL; @@ -1558,8 +1545,17 @@ HsInt loadOc (ObjectCode* oc) # endif #endif - /* loaded, but not resolved yet, ensure the OC is in a consistent state */ - setOcInitialStatus( oc ); + /* Loaded, but not resolved yet, ensure the OC is in a consistent state. + If a target has requested the ObjectCode not to be resolved then honor + this requests. Usually this means the ObjectCode has not been initialized + and can't be. */ + if (oc->status != OBJECT_DONT_RESOLVE) { + if (oc->archiveMemberName == NULL) { + oc->status = OBJECT_NEEDED; + } else { + oc->status = OBJECT_LOADED; + } + } IF_DEBUG(linker, debugBelch("loadOc: done.\n")); return 1; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16f83b5799f976b5ca839103fc83628ccc11b01f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16f83b5799f976b5ca839103fc83628ccc11b01f You're receiving 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 29 17:07:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 13:07:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f7369cd92f82_80b3f8453e298541539757d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 7c208390 by Sebastian Graf at 2020-09-29T13:07:19-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - e38a5992 by Richard Eisenberg at 2020-09-29T13:07:19-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/using.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - rts/posix/OSMem.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1eb75e11d9604218c84a5ba342c3023511c58ff3...e38a599220c11566b9efa043b0d4b60f5eb1d30b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1eb75e11d9604218c84a5ba342c3023511c58ff3...e38a599220c11566b9efa043b0d4b60f5eb1d30b You're receiving 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 29 17:22:07 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 13:22:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/keepAlive-optionH Message-ID: <5f736d3fc98be_80b3f84121342ac154000fb@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/keepAlive-optionH at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/keepAlive-optionH You're receiving 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 29 18:26:24 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 29 Sep 2020 14:26:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18755 Message-ID: <5f737c5098f3b_80b3f84595c6c10154239b2@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/T18755 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18755 You're receiving 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 29 19:01:08 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 29 Sep 2020 15:01:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/simplequote-infix-op Message-ID: <5f738474b1b3b_80bf29a090154377c0@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/simplequote-infix-op at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/simplequote-infix-op You're receiving 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 29 19:09:32 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 29 Sep 2020 15:09:32 -0400 Subject: [Git][ghc/ghc][wip/simplequote-infix-op] 8 commits: Optimize NthCo (FunCo ...) in coercion opt Message-ID: <5f73866cf82f_80bf54463815440584@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/simplequote-infix-op at Glasgow Haskell Compiler / GHC Commits: 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - ef449d9e by Vladislav Zavialov at 2020-09-29T22:09:22+03:00 SIMPLEQUOTE in qop/qopm - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Utils/Outputable.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/linear_types.rst - docs/users_guide/using.rst - libraries/base/Data/Typeable/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - rts/posix/OSMem.c - + testsuite/tests/ghci/scripts/T18501.script - + testsuite/tests/ghci/scripts/T18501.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/linear/should_compile/Linear1Rule.hs - testsuite/tests/linear/should_compile/LinearConstructors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/153d1141a1f86557ec6d2bf438b0ffd413f88552...ef449d9e1e5d4016ae036813a190e752242bab30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/153d1141a1f86557ec6d2bf438b0ffd413f88552...ef449d9e1e5d4016ae036813a190e752242bab30 You're receiving 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 29 21:21:11 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 29 Sep 2020 17:21:11 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Proof of Concept implementation of in-tree API Annotations Message-ID: <5f73a547cf3a1_80b3f8496294a28154469cc@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: fd5c8c5f by Alan Zimmerman at 2020-09-29T22:20:46+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 Remove LHsLocalBinds 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. - - - - - 19 changed files: - compiler/GHC.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - + compiler/GHC/Hs/Exact.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/Stats.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5c8c5f245629c643eda2f573ae4dc762476b98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd5c8c5f245629c643eda2f573ae4dc762476b98 You're receiving 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 29 21:46:09 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Tue, 29 Sep 2020 17:46:09 -0400 Subject: [Git][ghc/ghc][wip/cfuneqcan-refactor] Canonicalized function equalities. Message-ID: <5f73ab2179da1_80b3f8495f22fe8154533ef@gitlab.haskell.org.mail> Richard Eisenberg pushed to branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC Commits: 1183751d by Richard Eisenberg at 2020-09-29T17:45:44-04:00 Canonicalized function equalities. Now, onto interactions. - - - - - 2 changed files: - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Types/Constraint.hs Changes: ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -2161,17 +2161,10 @@ canEqCanLHSHomo :: CtEvidence canEqCanLHSHomo ev eq_rel swapped xi1 ps_xi1 xi2 ps_xi2 | (xi2', mco) <- split_cast_ty xi2 , isCanLHS xi2' - = canEqCanLHS2 ev eq_rel swapped xi1 ps_xi1 xi2' ps_xi2 mco - - | TyVarTy tv1 <- xi1 - = canEqTyVar ev eq_rel swapped tv1 ps_xi1 xi2 ps_xi2 - - | TyConApp fun_tc fun_args <- xi1 - = ASSERT( isTypeFamilyTyCon fun_tc ) - canEqFun ev eq_rel swapped fun_tc fun_args xi2 ps_xi2 + = canEqCanLHS2 ev eq_rel swapped xi1 ps_xi1 xi2' (ps_xi2 `mkCastTyMCo` mkSymMCo mco) mco | otherwise - = pprPanic "canEqCanLHS is not CanLHS" (ppr xi1 $$ ppr ev) + = canEqCanLHSSplit ev eq_rel swapped xi1 ps_xi1 xi2 ps_xi2 where split_cast_ty (CastTy ty co) = (ty, MCo co) @@ -2205,35 +2198,36 @@ canEqCanLHS2 ev eq_rel swapped xi1 ps_xi1 xi2 ps_xi2 mco | TyVarTy tv1 <- xi1 , TyConApp fun_tc2 fun_args2 <- xi2 - = canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 + = canEqTyVarFunEq ev eq_rel swapped tv1 ps_xi1 fun_tc2 fun_args2 ps_xi2 mco | TyConApp fun_tc1 fun_args1 <- xi1 , TyVarTy tv2 <- xi2 - = canEqTyVarFunEq ev eq_rel (flipSwap swapped) tv2 ps_xi2 fun_tc1 fun_args1 ps_xi1 + = canEqTyVarFunEq ev eq_rel (flipSwap swapped) tv2 ps_xi2 + fun_tc1 fun_args1 ps_xi1 (mkTcSymMCo mco) - | TyConApp fun_tc1 fun_args1 <- xi1 - , TyConApp fun_tc2 fun_args2 <- xi2 - = error "RAE isn't sure which order to prefer here." - -canEqTyVarHomo :: CtEvidence - -> EqRel -> SwapFlag - -> TcTyVar -- lhs: tv1 - -> TcType -- pretty lhs, flat - -> TcType -> TcType -- rhs, flat - -> TcS (StopOrContinue Ct) -canEqTyVarHomo ev eq_rel swapped tv1 ps_xi1 xi2 _ - | Just (tv2, _co) <- tcGetCastedTyVar_maybe xi2 - , tv1 == tv2 - = canEqReflexive ev eq_rel (mkTyVarTy tv1) - -- we don't need to check _co because it must be reflexive - - -- this guarantees (TyEq:TV) - | Just (tv2, co2) <- tcGetCastedTyVar_maybe xi2 - , swapOverTyVars (isGiven ev) tv1 tv2 - = -canEqTyVarHomo ev eq_rel swapped tv1 _ _ ps_xi2 - = do { dflags <- getDynFlags - ; canEqTyVar2 dflags ev eq_rel swapped tv1 ps_xi2 } + -- that's all the special cases. Now we just figure out which non-special case + -- to continue to. + | otherwise + = canEqCanLHSSplit ev eq_rel swapped xi1 ps_xi1 (xi2 `mkCastTyMCo` mco) + (ps_xi2 `mkCastTyMCo` mco) + +canEqCanLHSSplit :: CtEvidence + -> EqRel -> SwapFlag + -> CanLHS -- lhs (or, if swapped, rhs) + -> TcType -- pretty lhs + -> TcType -> TcType -- rhs, pretty rhs + -> TcS (StopOrContinue Ct) + -- precondition: kind(xi1) `eqType` kind(xi2) +canEqCanLHSSplit ev eq_rel swapped xi1 ps_xi1 xi2 ps_xi2 + | TyVarTy tv1 <- xi1 + = canEqTyVar ev eq_rel swapped tv1 ps_xi1 xi2 ps_xi2 + + | TyConApp fun_tc fun_args <- xi1 + = ASSERT( isTypeFamilyTyCon fun_tc ) + canEqFun ev eq_rel swapped fun_tc fun_args xi2 ps_xi2 + + | otherwise + = pprPanic "canEqCanLHS is not CanLHS" (ppr xi1 $$ ppr ev) canEqTyVar :: CtEvidence -> EqRel -> SwapFlag @@ -2310,6 +2304,29 @@ canEqTyVar2 dflags ev eq_rel swapped tv1 rhs rewrite_co1 = mkTcReflCo role lhs rewrite_co2 = mkTcReflCo role rhs +canEqFun :: CtEvidence + -> EqRel -> SwapFlag + -> TyCon -- type family + -> [TcType] -- family arguments (exactly saturated) + -> TcType -> TcType -- rhs, pretty rhs + -> TcS (StopOrContinue Ct) +canEqFun ev eq_rel swapped fun_tc fun_args rhs ps_rhs + = do { new_ev <- rewriteEqEvidence ev swapped lhs rhs rewrite_co1 rewrite_co2 + ; if isTauTy rhs -- establish CFunEqCan invariant + then + do { traceTcS "canEqFun makes canonical CFunEqCan" (ppr lhs $$ ppr ps_rhs) + ; continueWith (CFunEqCan { cc_ev = new_ev, cc_fun = fun_tc + , cc_tyargs = fun_args, cc_rhs = ps_rhs + , cc_eq_rel = eq_rel }) } + -- it is possible that cc_rhs mentions the LHS. This will cause later + -- flattening to potentially loop, but that will be caught by the + -- depth counter. The other option is an occurs-check for a function + -- application, which seems awkward. + + else + do { traceTcS "canEqFun fails" (ppr lhs $$ ppr ps_rhs) + ; continueWith (mkIrredCt InsolubleCIS new_ev) }} + -- | Solve a reflexive equality constraint canEqReflexive :: CtEvidence -- ty ~ ty -> EqRel ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -173,6 +173,7 @@ data Ct -- Invariants: -- * isTypeFamilyTyCon cc_fun -- * tcTypeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant] + -- * isTauTy cc_rhs; type family reducts are always tau-types cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant] cc_fun :: TyCon, -- A type function View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1183751d8599986eb206305f821a59d83b906596 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1183751d8599986eb206305f821a59d83b906596 You're receiving 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 29 22:10:51 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Tue, 29 Sep 2020 18:10:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backport-9.0-linear-types-syntax Message-ID: <5f73b0eb498f6_80b3f8410f00630154569a5@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/backport-9.0-linear-types-syntax at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backport-9.0-linear-types-syntax You're receiving 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 29 23:25:08 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 19:25:08 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f73c254d23af_80b3f848b61740815465474@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 Tue Sep 29 23:25:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 29 Sep 2020 19:25:10 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 4 commits: Pattern guards BindStmt always use multiplicity Many Message-ID: <5f73c256d2f49_80b3f848a2a9dbc15465618@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: edfa896e by Arnaud Spiwack at 2020-09-29T11:41:25-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. (cherry picked from commit 2707c4eae4cf99e6da2709e128f560d91e468357) - - - - - a64ea9d0 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Disallow linear types in FFI (#18472) (cherry picked from commit 160fba4aa306c0649c72a6dcd7c98d9782a0e74b) - - - - - f8d8c343 by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH (cherry picked from commit 83407ffc7acc00cc025b9f6ed063add9ab9f9bcc) - - - - - 90fe5cff by Krzysztof Gogolewski at 2020-09-29T11:41:25-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. (cherry picked from commit e124f2a7d9a5932a4c2383fd3f9dd772b2059885) - - - - - 20 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Match.hs - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/extending_ghc.rst - docs/users_guide/exts/defer_type_errors.rst - docs/users_guide/exts/ffi.rst - docs/users_guide/exts/safe_haskell.rst - docs/users_guide/exts/template_haskell.rst - docs/users_guide/exts/typed_holes.rst - docs/users_guide/using-optimisation.rst - + testsuite/tests/linear/should_fail/LinearFFI.hs - + testsuite/tests/linear/should_fail/LinearFFI.stderr - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs - + testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr - testsuite/tests/linear/should_fail/all.T - + testsuite/tests/simplCore/should_compile/T18747A.hs - + testsuite/tests/simplCore/should_compile/T18747B.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1469,7 +1469,7 @@ instCoercion (Pair lty rty) g w | isFunTy lty && isFunTy rty -- g :: (t1 -> t2) ~ (t3 -> t4) -- returns t2 ~ t4 - = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->) + = Just $ mkNthCo Nominal 4 g -- extract result type, which is the 5th argument to (->) | otherwise -- one forall, one funty... = Nothing ===================================== compiler/GHC/Tc/Gen/Foreign.hs ===================================== @@ -237,7 +237,7 @@ tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty -- things are LocalIds. However, it does not need zonking, -- (so GHC.Tc.Utils.Zonk.zonkForeignExports ignores it). - ; imp_decl' <- tcCheckFIType (map scaledThing arg_tys) res_ty imp_decl + ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl -- Can't use sig_ty here because sig_ty :: Type and -- we need HsType Id hence the undefined ; let fi_decl = ForeignImport { fd_name = L nloc id @@ -249,14 +249,14 @@ tcFImport d = pprPanic "tcFImport" (ppr d) -- ------------ Checking types for foreign import ---------------------- -tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport +tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src) -- Foreign import label = do checkCg checkCOrAsmOrLlvmOrInterp -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) - check (isFFILabelTy (mkVisFunTysMany arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) + check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) cconv' <- checkCConv cconv return (CImport (L lc cconv') safety mh l src) @@ -268,7 +268,9 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do checkCg checkCOrAsmOrLlvmOrInterp cconv' <- checkCConv cconv case arg_tys of - [arg1_ty] -> do checkForeignArgs isFFIExternalTy (map scaledThing arg1_tys) + [Scaled arg1_mult arg1_ty] -> do + checkNoLinearFFI arg1_mult + checkForeignArgs isFFIExternalTy arg1_tys checkForeignRes nonIOok checkSafe isFFIExportResultTy res1_ty checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty where @@ -284,9 +286,10 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh case arg_tys of -- The first arg must be Ptr or FunPtr [] -> addErrTc (illegalForeignTyErr Outputable.empty (text "At least one argument expected")) - (arg1_ty:arg_tys) -> do + (Scaled arg1_mult arg1_ty:arg_tys) -> do dflags <- getDynFlags - let curried_res_ty = mkVisFunTysMany arg_tys res_ty + let curried_res_ty = mkVisFunTys arg_tys res_ty + checkNoLinearFFI arg1_mult check (isFFIDynTy curried_res_ty arg1_ty) (illegalForeignTyErr argument) checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys @@ -311,7 +314,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh dflags <- getDynFlags checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty - checkMissingAmpersand dflags arg_tys res_ty + checkMissingAmpersand dflags (map scaledThing arg_tys) res_ty case target of StaticTarget _ _ _ False | not (null arg_tys) -> @@ -399,7 +402,7 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do checkCg checkCOrAsmOrLlvm checkTc (isCLabelString str) (badCName str) cconv' <- checkCConv cconv - checkForeignArgs isFFIExternalTy (map scaledThing arg_tys) + checkForeignArgs isFFIExternalTy arg_tys checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty return (CExport (L l (CExportStatic esrc str cconv')) src) where @@ -416,10 +419,16 @@ tcCheckFEType sig_ty (CExport (L l (CExportStatic esrc str cconv)) src) = do -} ------------ Checking argument types for foreign import ---------------------- -checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM () +checkForeignArgs :: (Type -> Validity) -> [Scaled Type] -> TcM () checkForeignArgs pred tys = mapM_ go tys where - go ty = check (pred ty) (illegalForeignTyErr argument) + go (Scaled mult ty) = checkNoLinearFFI mult >> + check (pred ty) (illegalForeignTyErr argument) + +checkNoLinearFFI :: Mult -> TcM () -- No linear types in FFI (#18472) +checkNoLinearFFI Many = return () +checkNoLinearFFI _ = addErrTc $ illegalForeignTyErr argument + (text "Linear types are not supported in FFI declarations, see #18472") ------------ Checking result types for foreign calls ---------------------- -- | Check that the type has the form ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -388,7 +388,14 @@ tcGuardStmt _ (BodyStmt _ guard _ _) res_ty thing_inside ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) } tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside - = do { (rhs', rhs_ty) <- tcInferRhoNC rhs + = do { -- The Many on the next line and the unrestricted on the line after + -- are linked. These must be the same multiplicity. Consider + -- x <- rhs -> u + -- + -- The multiplicity of x in u must be the same as the multiplicity at + -- which the rhs has been consumed. When solving #18738, we want these + -- two multiplicity to still be the same. + (rhs', rhs_ty) <- tcScalingUsage Many $ tcInferRhoNC rhs -- Stmt has a context already ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ ===================================== docs/users_guide/conf.py ===================================== @@ -38,9 +38,6 @@ nitpick_ignore = [ ("extension", "DoAndIfThenElse"), ("extension", "RelaxedPolyRec"), - - # See #16629 - ("extension", "UnliftedFFITypes"), ] rst_prolog = """ @@ -96,13 +93,13 @@ htmlhelp_basename = 'GHCUsersGuide' latex_elements = { 'inputenc': '', 'utf8extra': '', - 'preamble': ''' + 'preamble': r''' \usepackage{fontspec} \usepackage{makeidx} \setsansfont{DejaVu Sans} \setromanfont{DejaVu Serif} \setmonofont{DejaVu Sans Mono} -\setlength{\\tymin}{45pt} +\setlength{\tymin}{45pt} % Avoid a torrent of over-full \hbox warnings \usepackage{microtype} ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -38,7 +38,6 @@ -XAutoDeriveTypeable -XDoAndIfThenElse -XDoRec --XGHCForeignImportPrim -XGenerics -XImplicitPrelude -XJavaScriptFFI ===================================== docs/users_guide/extending_ghc.rst ===================================== @@ -800,8 +800,8 @@ displayed. import GHC.Hs.Decls import GHC.Hs.Expr import GHC.Hs.ImpExp - import Avail - import Outputable + import GHC.Types.Avail + import GHC.Utils.Outputable import GHC.Hs.Doc plugin :: Plugin ===================================== docs/users_guide/exts/defer_type_errors.rst ===================================== @@ -115,6 +115,7 @@ In a few cases, even equality constraints cannot be deferred. Specifically: This type signature contains a kind error which cannot be deferred. -- Type equalities under a forall cannot be deferred (c.f. #14605). +- Type equalities under a forall cannot be deferred (c.f. `#14605 + `_). ===================================== docs/users_guide/exts/ffi.rst ===================================== @@ -263,8 +263,13 @@ and is not permitted to appear nested within the type, as in the following Primitive imports ~~~~~~~~~~~~~~~~~ -GHC extends the FFI with an additional calling convention ``prim``, -e.g.: :: +.. extension:: GHCForeignImportPrim + :shortdesc: Enable prim calling convention. Intended for internal use only. + + :since: 6.12.1 + +With :extension:`GHCForeignImportPrim`, GHC extends the FFI with an additional +calling convention ``prim``, e.g.: :: foreign import prim "foo" foo :: ByteArray# -> (# Int#, Int# #) ===================================== docs/users_guide/exts/safe_haskell.rst ===================================== @@ -781,7 +781,7 @@ And five warning flags: :shortdesc: warn when an explicitly Safe Haskell module imports a Safe-Inferred one :type: dynamic :reverse: -Wno-inferred-safe-imports - :category: + :category: warnings :since: 8.10.1 @@ -815,7 +815,7 @@ And five warning flags: :shortdesc: warn when the Safe Haskell mode is not explicitly specified. :type: dynamic :reverse: -Wno-missing-safe-haskell-mode - :category: + :category: warnings :since: 8.10.1 ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -109,7 +109,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under plusC = [| $oneC + $twoC |] -- The precise type of a quotation depends on the types of the nested splices inside it:: +- The precise type of a quotation depends on the types of the nested splices inside it:: -- Add a redundant constraint to demonstrate that constraints on the -- monad used to build the representation are propagated when using nested @@ -125,9 +125,8 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under Remember, a top-level splice still requires its argument to be of type ``Q Exp``. So then splicing in ``g`` will cause ``m`` to be instantiated to ``Q``:: - h :: Int - h = $(g) -- m ~ Q - + h :: Int + h = $(g) -- m ~ Q - A *typed* expression splice is written ``$$x``, where ``x`` is is an arbitrary expression. @@ -376,8 +375,6 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under However, there are some GHC-specific extensions which expression quotations currently do not support, including - - Recursive ``do``-statements (see :ghc-ticket:`1262`) - - Type holes in typed splices (see :ghc-ticket:`10945` and :ghc-ticket:`10946`) ===================================== docs/users_guide/exts/typed_holes.rst ===================================== @@ -546,6 +546,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits` :shortdesc: Sort valid hole fits by size. :type: dynamic :reverse: -fno-sort-by-size-hole-fits + :category: verbosity :default: on @@ -557,6 +558,7 @@ Sorting can be toggled with :ghc-flag:`-fsort-valid-hole-fits` :shortdesc: Sort valid hole fits by subsumption. :type: dynamic :reverse: -fno-sort-by-subsumption-hole-fits + :category: verbosity :default: off ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -362,6 +362,7 @@ by saying ``-fno-wombat``. :default: on Use a special demand transformer for dictionary selectors. + Behaviour is unconditionally enabled starting with 9.2 .. ghc-flag:: -fdo-eta-reduction :shortdesc: Enable eta-reduction. Implied by :ghc-flag:`-O`. ===================================== testsuite/tests/linear/should_fail/LinearFFI.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE LinearTypes #-} +module LinearFFI where -- #18472 + +import Foreign.Ptr + +foreign import ccall "exp" c_exp :: Double #-> Double +foreign import stdcall "dynamic" d8 :: FunPtr (IO Int) #-> IO Int +foreign import ccall "wrapper" mkF :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/LinearFFI.stderr ===================================== @@ -0,0 +1,20 @@ + +LinearFFI.hs:6:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "exp" c_exp :: Double #-> Double + +LinearFFI.hs:7:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import stdcall safe "dynamic" d8 + :: FunPtr (IO Int) #-> IO Int + +LinearFFI.hs:8:1: error: + • Unacceptable argument type in foreign declaration: + Linear types are not supported in FFI declarations, see #18472 + • When checking declaration: + foreign import ccall safe "wrapper" mkF + :: IO () #-> IO (FunPtr (IO ())) ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE LinearTypes #-} +module LinearPatternGuardWildcard where + +-- See #18439 + +unsafeConsume :: a #-> () +unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/LinearPatternGuardWildcard.stderr ===================================== @@ -0,0 +1,5 @@ + +LinearPatternGuardWildcard.hs:7:15: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘unsafeConsume’: unsafeConsume x | _ <- x = () ===================================== testsuite/tests/linear/should_fail/all.T ===================================== @@ -27,3 +27,5 @@ test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile test('LinearBottomMult', normal, compile_fail, ['']) test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) +test('LinearPatternGuardWildcard', normal, compile_fail, ['']) +test('LinearFFI', normal, compile_fail, ['']) ===================================== testsuite/tests/simplCore/should_compile/T18747A.hs ===================================== @@ -0,0 +1,82 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T18747A where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type +data SomeSing :: Type -> Type where + SomeSing :: Sing (a :: k) -> SomeSing k + +data SList :: forall a. [a] -> Type where + SNil :: SList '[] + SCons :: Sing x -> Sing xs -> SList (x:xs) +type instance Sing = SList + +data Univ = U1 | K1 Type | Sum Univ Univ | Product Univ Univ + +data SUniv :: Univ -> Type where + SU1 :: SUniv U1 + SK1 :: Sing c -> SUniv (K1 c) + SSum :: Sing a -> Sing b -> SUniv (Sum a b) + SProduct :: Sing a -> Sing b -> SUniv (Product a b) +type instance Sing = SUniv + +data In :: Univ -> Type where + MkU1 :: In U1 + MkK1 :: c -> In (K1 c) + L1 :: In a -> In (Sum a b) + R1 :: In b -> In (Sum a b) + MkProduct :: In a -> In b -> In (Product a b) + +data SIn :: forall u. In u -> Type where + SMkU1 :: SIn MkU1 + SMkK1 :: Sing c -> SIn (MkK1 c) + SL1 :: Sing a -> SIn (L1 a) + SR1 :: Sing b -> SIn (R1 b) + SMkProduct :: Sing a -> Sing b -> SIn (MkProduct a b) +type instance Sing = SIn + +class Generic (a :: Type) where + type Rep a :: Univ + from :: a -> In (Rep a) + to :: In (Rep a) -> a + +class PGeneric (a :: Type) where + type PFrom (x :: a) :: In (Rep a) + type PTo (x :: In (Rep a)) :: a + +class SGeneric k where + sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) + sTo :: forall (a :: In (Rep k)). Sing a -> Sing (PTo a :: k) + sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a + sFot :: forall (a :: In (Rep k)). Sing a -> PFrom (PTo a :: k) :~: a + +instance Generic [a] where + type Rep [a] = Sum U1 (Product (K1 a) (K1 [a])) + from [] = L1 MkU1 + from (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + to (L1 MkU1) = [] + to (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance PGeneric [a] where + type PFrom '[] = L1 MkU1 + type PFrom (x:xs) = R1 (MkProduct (MkK1 x) (MkK1 xs)) + type PTo (L1 MkU1) = '[] + type PTo (R1 (MkProduct (MkK1 x) (MkK1 xs))) = x:xs + +instance SGeneric [a] where + sFrom SNil = SL1 SMkU1 + sFrom (SCons x xs) = SR1 (SMkProduct (SMkK1 x) (SMkK1 xs)) + sTo (SL1 SMkU1) = SNil + sTo (SR1 (SMkProduct (SMkK1 x) (SMkK1 xs))) = SCons x xs + sTof SNil = Refl + sTof SCons{} = Refl + sFot (SL1 SMkU1) = Refl + sFot (SR1 (SMkProduct SMkK1{} SMkK1{})) = Refl ===================================== testsuite/tests/simplCore/should_compile/T18747B.hs ===================================== @@ -0,0 +1,50 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T18747B where + +import Data.Kind +import Data.Type.Equality + +type family Sing :: k -> Type + +data SomeSing (k :: Type) where + SomeSing :: Sing (a :: k) -> SomeSing k + +type family Promote (k :: Type) :: Type +type family PromoteX (a :: k) :: Promote k + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +type SingKindX (a :: k) = (PromoteX (DemoteX a) ~~ a) + +class SingKindX k => SingKind k where + toSing :: Demote k -> SomeSing k + +type instance Demote Type = Type +type instance Promote Type = Type +type instance DemoteX (a :: Type) = Demote a +type instance PromoteX (a :: Type) = Promote a + +type instance Demote Bool = Bool +type instance Promote Bool = Bool + +data Foo (a :: Type) where MkFoo :: Foo Bool + +data SFoo :: forall a. Foo a -> Type where + SMkFoo :: SFoo MkFoo +type instance Sing = SFoo + +type instance Demote (Foo a) = Foo (DemoteX a) +type instance Promote (Foo a) = Foo (PromoteX a) + +instance SingKindX a => SingKind (Foo a) where + toSing MkFoo = SomeSing SMkFoo + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,6 @@ 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('T18747A', normal, compile, ['']) +test('T18747B', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebcc09687b8d84daf00987a466834a20a9831e7b...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebcc09687b8d84daf00987a466834a20a9831e7b...90fe5cffb0b0ba1ff86b8b9bf5299d0ed8437ad7 You're receiving 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 30 00:27:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 29 Sep 2020 20:27:49 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Make the parser module less dependent on DynFlags Message-ID: <5f73d105b1a54_80b3f8469eb118015491952@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 76a89aa4 by Sebastian Graf at 2020-09-29T20:27:39-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 50ec6ae3 by Ben Gamari at 2020-09-29T20:27:40-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 60c9f8f9 by Ben Gamari at 2020-09-29T20:27:40-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - d715c4a9 by Sylvain Henry at 2020-09-29T20:27:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - eaab32ed by Sylvain Henry at 2020-09-29T20:27:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7011deab by Richard Eisenberg at 2020-09-29T20:27:41-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - f6ce34b1 by Sebastian Graf at 2020-09-29T20:27:42-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - b39d9555 by Richard Eisenberg at 2020-09-29T20:27:42-04:00 Regression test for #10709. Close #10709 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Utils/Error.hs - + compiler/GHC/Utils/GlobalVars.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Panic.hs - compiler/HsVersions.h - compiler/ghc.cabal.in - ghc/GHCi/UI.hs - ghc/ghc-bin.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e38a599220c11566b9efa043b0d4b60f5eb1d30b...b39d9555b0b4df45baae05f72b4f7fd4141dcaaa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e38a599220c11566b9efa043b0d4b60f5eb1d30b...b39d9555b0b4df45baae05f72b4f7fd4141dcaaa You're receiving 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 30 06:29:13 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 02:29:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/pretty-print-mult-arr Message-ID: <5f7425b94c002_80b3f84387f32d4155087c2@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/pretty-print-mult-arr at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/pretty-print-mult-arr You're receiving 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 30 06:30:14 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 02:30:14 -0400 Subject: [Git][ghc/ghc][wip/pretty-print-mult-arr] Fix pretty-printing of the mult-polymorphic arrow Message-ID: <5f7425f697293_80b761ba8c155089f1@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/pretty-print-mult-arr at Glasgow Haskell Compiler / GHC Commits: 075d66c8 by Vladislav Zavialov at 2020-09-30T09:29:59+03:00 Fix pretty-printing of the mult-polymorphic arrow A follow-up to !4020 (5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - 6 changed files: - compiler/GHC/Utils/Outputable.hs - testsuite/tests/linear/should_fail/LinearErrOrigin.stderr - testsuite/tests/linear/should_fail/LinearPartialSig.stderr - testsuite/tests/linear/should_fail/LinearVar.stderr - testsuite/tests/roles/should_compile/Roles13.stderr - testsuite/tests/simplCore/should_compile/T4201.stdout Changes: ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -677,7 +677,7 @@ lbrace = docToSDoc $ Pretty.lbrace rbrace = docToSDoc $ Pretty.rbrace mulArrow :: SDoc -> SDoc -mulArrow d = text "#" <+> d <+> arrow +mulArrow d = text "%" <> d <+> arrow forAllLit :: SDoc ===================================== testsuite/tests/linear/should_fail/LinearErrOrigin.stderr ===================================== @@ -5,15 +5,15 @@ LinearErrOrigin.hs:7:7: error: the type signature for: foo :: forall a b (p :: GHC.Types.Multiplicity) (q :: GHC.Types.Multiplicity). - (a # p -> b) -> a # q -> b + (a %p -> b) -> a %q -> b at LinearErrOrigin.hs:6:1-31 ‘q’ is a rigid type variable bound by the type signature for: foo :: forall a b (p :: GHC.Types.Multiplicity) (q :: GHC.Types.Multiplicity). - (a # p -> b) -> a # q -> b + (a %p -> b) -> a %q -> b at LinearErrOrigin.hs:6:1-31 • In an equation for ‘foo’: foo f x = f x • Relevant bindings include - f :: a # p -> b (bound at LinearErrOrigin.hs:7:5) - foo :: (a # p -> b) -> a # q -> b (bound at LinearErrOrigin.hs:7:1) + f :: a %p -> b (bound at LinearErrOrigin.hs:7:5) + foo :: (a %p -> b) -> a %q -> b (bound at LinearErrOrigin.hs:7:1) ===================================== testsuite/tests/linear/should_fail/LinearPartialSig.stderr ===================================== @@ -3,5 +3,5 @@ LinearPartialSig.hs:5:9: error: • Found type wildcard ‘_’ standing for ‘'Many :: GHC.Types.Multiplicity’ To use the inferred type, enable PartialTypeSignatures - • In the type ‘a # _ -> a’ - In the type signature: f :: a # _ -> a + • In the type ‘a %_ -> a’ + In the type signature: f :: a %_ -> a ===================================== testsuite/tests/linear/should_fail/LinearVar.stderr ===================================== @@ -1,13 +1,13 @@ LinearVar.hs:5:5: error: • Couldn't match type ‘m’ with ‘'Many’ - Expected: a # m -> b + Expected: a %m -> b Actual: a -> b ‘m’ is a rigid type variable bound by the type signature for: - f :: forall a b (m :: GHC.Types.Multiplicity). a # m -> b + f :: forall a b (m :: GHC.Types.Multiplicity). a %m -> b at LinearVar.hs:4:1-14 • In the expression: undefined :: a -> b In an equation for ‘f’: f = undefined :: a -> b • Relevant bindings include - f :: a # m -> b (bound at LinearVar.hs:5:1) + f :: a %m -> b (bound at LinearVar.hs:5:1) ===================================== testsuite/tests/roles/should_compile/Roles13.stderr ===================================== @@ -14,7 +14,7 @@ convert :: Wrap Age -> Int convert = convert1 `cast` (_R - # <'Many>_N ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0]) + %<'Many>_N ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0]) :: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} ===================================== testsuite/tests/simplCore/should_compile/T4201.stdout ===================================== @@ -1,4 +1,4 @@ [HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1, Strictness: , Unfolding: InlineRule (0, True, True) - bof `cast` (Sym (N:Foo[0]) # <'Many>_N ->_R _R)] + bof `cast` (Sym (N:Foo[0]) %<'Many>_N ->_R _R)] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/075d66c8b8ad7b9a9fbb962d4ac0049961695395 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/075d66c8b8ad7b9a9fbb962d4ac0049961695395 You're receiving 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 30 06:48:01 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:48:01 -0400 Subject: [Git][ghc/ghc][master] Make the parser module less dependent on DynFlags Message-ID: <5f742a213907_80b3f8468f821a0155171ba@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 15 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Runtime/Eval.hs - ghc/GHCi/UI.hs - testsuite/tests/ghc-api/T11579.hs - testsuite/tests/ghc-api/T9015.hs - testsuite/tests/parser/should_run/CountParserDeps.hs - utils/haddock Changes: ===================================== compiler/GHC.hs ===================================== @@ -303,6 +303,7 @@ import GHCi.RemoteTypes import GHC.Core.Ppr.TyThing ( pprFamInst ) import GHC.Driver.Backend +import GHC.Driver.Config import GHC.Driver.Main import GHC.Driver.Make import GHC.Driver.Hooks @@ -1426,9 +1427,9 @@ getModuleSourceAndFlags mod = do -- Throws a 'GHC.Driver.Types.SourceError' on parse error. getTokenStream :: GhcMonad m => Module -> m [Located Token] getTokenStream mod = do - (sourceFile, source, flags) <- getModuleSourceAndFlags mod + (sourceFile, source, dflags) <- getModuleSourceAndFlags mod let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1 - case lexTokenStream source startLoc flags of + case lexTokenStream (initParserOpts dflags) source startLoc of POk _ ts -> return ts PFailed pst -> do dflags <- getDynFlags @@ -1439,9 +1440,9 @@ getTokenStream mod = do -- 'showRichTokenStream'. getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)] getRichTokenStream mod = do - (sourceFile, source, flags) <- getModuleSourceAndFlags mod + (sourceFile, source, dflags) <- getModuleSourceAndFlags mod let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1 - case lexTokenStream source startLoc flags of + case lexTokenStream (initParserOpts dflags) source startLoc of POk _ ts -> return $ addSourceToTokens startLoc source ts PFailed pst -> do dflags <- getDynFlags @@ -1616,7 +1617,7 @@ parser str dflags filename = loc = mkRealSrcLoc (mkFastString filename) 1 1 buf = stringToStringBuffer str in - case unP Parser.parseModule (mkPState dflags buf loc) of + case unP Parser.parseModule (initParserState (initParserOpts dflags) buf loc) of PFailed pst -> let (warns,errs) = getMessages pst dflags in ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -249,6 +249,7 @@ import GHC.Types.Unique.FM import GHC.Types.SrcLoc import GHC.Driver.Session import GHC.Driver.Ppr +import GHC.Driver.Config import GHC.Utils.Error import GHC.Data.StringBuffer import GHC.Data.FastString @@ -1432,7 +1433,8 @@ parseCmmFile dflags filename = withTiming dflags (text "ParseCmm"<+>brackets (te buf <- hGetStringBuffer filename let init_loc = mkRealSrcLoc (mkFastString filename) 1 1 - init_state = (mkPState dflags buf init_loc) { lex_state = [0] } + opts = initParserOpts dflags + init_state = (initParserState opts buf init_loc) { lex_state = [0] } -- reset the lex_state: the Lexer monad leaves some stuff -- in there we don't want. case unPD cmmParse dflags init_state of ===================================== compiler/GHC/Driver/Backpack.hs ===================================== @@ -27,6 +27,7 @@ import GHC.Parser.Annotation import GHC hiding (Failed, Succeeded) import GHC.Parser import GHC.Parser.Lexer +import GHC.Driver.Config import GHC.Driver.Monad import GHC.Driver.Session import GHC.Driver.Ppr @@ -83,7 +84,7 @@ doBackpack [src_filename] = do buf <- liftIO $ hGetStringBuffer src_filename let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 -- TODO: not great - case unP parseBackpack (mkPState dflags buf loc) of + case unP parseBackpack (initParserState (initParserOpts dflags) buf loc) of PFailed pst -> throwErrors (getErrorMessages pst dflags) POk _ pkgname_bkp -> do -- OK, so we have an LHsUnit PackageName, but we want an ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Driver.Config ( initOptCoercionOpts , initSimpleOpts + , initParserOpts ) where @@ -10,6 +11,7 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Core.SimpleOpt import GHC.Core.Coercion.Opt +import GHC.Parser.Lexer -- | Initialise coercion optimiser configuration from DynFlags initOptCoercionOpts :: DynFlags -> OptCoercionOpts @@ -23,3 +25,15 @@ initSimpleOpts dflags = SimpleOpts { so_uf_opts = unfoldingOpts dflags , so_co_opts = initOptCoercionOpts dflags } + +-- | Extracts the flag information needed for parsing +initParserOpts :: DynFlags -> ParserOpts +initParserOpts = + mkParserOpts + <$> warningFlags + <*> extensionFlags + <*> homeUnitId_ + <*> safeImportsOn + <*> gopt Opt_Haddock + <*> gopt Opt_KeepRawTokenStream + <*> const True ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Cmm.Info.Build import GHC.Cmm.Pipeline import GHC.Cmm.Info import GHC.Driver.CodeOutput +import GHC.Driver.Config import GHC.Core.InstEnv import GHC.Core.FamInstEnv import GHC.Utils.Fingerprint ( Fingerprint ) @@ -353,7 +354,7 @@ hscParse' mod_summary = parseSignature | otherwise = parseModule - case unP parseMod (mkPState dflags buf loc) of + case unP parseMod (initParserState (initParserOpts dflags) buf loc) of PFailed pst -> handleWarningsThrowErrors (getMessages pst dflags) POk pst rdr_module -> do @@ -1875,7 +1876,7 @@ hscParseThingWithLocation source linenumber parser str let buf = stringToStringBuffer str loc = mkRealSrcLoc (fsLit source) linenumber 1 - case unP parser (mkPState dflags buf loc) of + case unP parser (initParserState (initParserOpts dflags) buf loc) of PFailed pst -> do handleWarningsThrowErrors (getMessages pst dflags) ===================================== compiler/GHC/Parser.y ===================================== @@ -21,13 +21,13 @@ -- and then parse that string: -- -- @ --- runParser :: DynFlags -> String -> P a -> ParseResult a --- runParser flags str parser = unP parser parseState +-- runParser :: ParserOpts -> String -> P a -> ParseResult a +-- runParser opts str parser = unP parser parseState -- where -- filename = "\" -- location = mkRealSrcLoc (mkFastString filename) 1 1 -- buffer = stringToStringBuffer str --- parseState = mkPState flags buffer location +-- parseState = initParserState opts buffer location -- @ module GHC.Parser ( parseModule, parseSignature, parseImport, parseStatement, parseBackpack ===================================== compiler/GHC/Parser/Header.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Builtin.Names import GHC.Data.StringBuffer import GHC.Types.SrcLoc import GHC.Driver.Session +import GHC.Driver.Config import GHC.Utils.Error import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable @@ -73,7 +74,7 @@ getImports :: DynFlags -- names from -XPackageImports), and the module name. getImports dflags buf filename source_filename = do let loc = mkRealSrcLoc (mkFastString filename) 1 1 - case unP parseHeader (mkPState dflags buf loc) of + case unP parseHeader (initParserState (initParserOpts dflags) buf loc) of PFailed pst -> -- assuming we're not logging warnings here as per below return $ Left $ getErrorMessages pst dflags @@ -178,7 +179,8 @@ blockSize = 1024 lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token] lazyGetToks dflags filename handle = do buf <- hGetStringBufferBlock handle blockSize - unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize + let prag_state = initPragState (initParserOpts dflags) buf loc + unsafeInterleaveIO $ lazyLexBuf handle prag_state False blockSize where loc = mkRealSrcLoc (mkFastString filename) 1 1 @@ -214,8 +216,9 @@ lazyGetToks dflags filename handle = do getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token] -getToks dflags filename buf = lexAll (pragState dflags buf loc) +getToks dflags filename buf = lexAll pstate where + pstate = initPragState (initParserOpts dflags) buf loc loc = mkRealSrcLoc (mkFastString filename) 1 1 lexAll state = case unP (lexer False return) state of ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -49,8 +49,10 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Parser.Lexer ( - Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..), - P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..), + Token(..), lexer, lexerDbg, + ParserOpts(..), mkParserOpts, + PState (..), initParserState, initPragState, + P(..), ParseResult(..), appendWarning, appendError, allocateComments, @@ -62,7 +64,7 @@ module GHC.Parser.Lexer ( activeContext, nextIsEOF, getLexState, popLexState, pushLexState, ExtBits(..), - xtest, + xtest, xunset, xset, lexTokenStream, AddAnn(..),mkParensApiAnn, addAnnsAt, @@ -2207,12 +2209,13 @@ data ParseResult a -- a non-empty bag of errors. -- | Test whether a 'WarningFlag' is set -warnopt :: WarningFlag -> ParserFlags -> Bool +warnopt :: WarningFlag -> ParserOpts -> Bool warnopt f options = f `EnumSet.member` pWarningFlags options --- | The subset of the 'DynFlags' used by the parser. --- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this. -data ParserFlags = ParserFlags { +-- | Parser options. +-- +-- See 'mkParserOpts' to construct this. +data ParserOpts = ParserOpts { pWarningFlags :: EnumSet WarningFlag , pHomeUnitId :: UnitId -- ^ id of the unit currently being compiled -- (only used in Cmm parser) @@ -2230,7 +2233,7 @@ data HdkComment data PState = PState { buffer :: StringBuffer, - options :: ParserFlags, + options :: ParserOpts, -- This needs to take DynFlags as an argument until -- we have a fix for #10143 messages :: DynFlags -> Messages, @@ -2570,6 +2573,12 @@ xbit = bit . fromEnum xtest :: ExtBits -> ExtsBitmap -> Bool xtest ext xmap = testBit xmap (fromEnum ext) +xset :: ExtBits -> ExtsBitmap -> ExtsBitmap +xset ext xmap = setBit xmap (fromEnum ext) + +xunset :: ExtBits -> ExtsBitmap -> ExtsBitmap +xunset ext xmap = clearBit xmap (fromEnum ext) + -- | Various boolean flags, mostly language extensions, that impact lexing and -- parsing. Note that a handful of these can change during lexing/parsing. data ExtBits @@ -2630,19 +2639,8 @@ data ExtBits -- tokens of their own. deriving Enum - - - - --- PState for parsing options pragmas --- -pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState -pragState dynflags buf loc = (mkPState dynflags buf loc) { - lex_state = [bol, option_prags, 0] - } - -{-# INLINE mkParserFlags' #-} -mkParserFlags' +{-# INLINE mkParserOpts #-} +mkParserOpts :: EnumSet WarningFlag -- ^ warnings flags enabled -> EnumSet LangExt.Extension -- ^ permitted language extensions enabled -> UnitId -- ^ id of the unit currently being compiled @@ -2656,11 +2654,11 @@ mkParserFlags' -- the internal position kept by the parser. Otherwise, those pragmas are -- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens. - -> ParserFlags --- ^ Given exactly the information needed, set up the 'ParserFlags' -mkParserFlags' warningFlags extensionFlags homeUnitId + -> ParserOpts +-- ^ Given exactly the information needed, set up the 'ParserOpts' +mkParserOpts warningFlags extensionFlags homeUnitId safeImports isHaddock rawTokStream usePosPrags = - ParserFlags { + ParserOpts { pWarningFlags = warningFlags , pHomeUnitId = homeUnitId , pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits @@ -2722,25 +2720,15 @@ mkParserFlags' warningFlags extensionFlags homeUnitId b `setBitIf` cond | cond = xbit b | otherwise = 0 --- | Extracts the flag information needed for parsing -mkParserFlags :: DynFlags -> ParserFlags -mkParserFlags = - mkParserFlags' - <$> DynFlags.warningFlags - <*> DynFlags.extensionFlags - <*> DynFlags.homeUnitId_ - <*> safeImportsOn - <*> gopt Opt_Haddock - <*> gopt Opt_KeepRawTokenStream - <*> const True - --- | Creates a parse state from a 'DynFlags' value -mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState -mkPState flags = mkPStatePure (mkParserFlags flags) - --- | Creates a parse state from a 'ParserFlags' value -mkPStatePure :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState -mkPStatePure options buf loc = +-- | Set parser options for parsing OPTIONS pragmas +initPragState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState +initPragState options buf loc = (initParserState options buf loc) + { lex_state = [bol, option_prags, 0] + } + +-- | Creates a parse state from a 'ParserOpts' value +initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState +initParserState options buf loc = PState { buffer = buf, options = options, @@ -2818,7 +2806,7 @@ appendError srcspan msg m = in (ws, es') appendWarning - :: ParserFlags + :: ParserOpts -> WarningFlag -> SrcSpan -> SDoc @@ -2928,7 +2916,7 @@ getOffside = P $ \s at PState{last_loc=loc, context=stk} -> -- Construct a parse error srcParseErr - :: ParserFlags + :: ParserOpts -> StringBuffer -- current buffer (placed just after the last token) -> Int -- length of the previous token -> MsgDoc @@ -3248,16 +3236,20 @@ reportLexError loc1 loc2 buf str then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)") else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c) -lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token] -lexTokenStream buf loc dflags = unP go initState{ options = opts' } - where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream - initState at PState{ options = opts } = mkPState dflags' buf loc - opts' = opts{ pExtsBitmap = complement (xbit UsePosPragsBit) .&. pExtsBitmap opts } - go = do - ltok <- lexer False return - case ltok of - L _ ITeof -> return [] - _ -> liftM (ltok:) go +lexTokenStream :: ParserOpts -> StringBuffer -> RealSrcLoc -> ParseResult [Located Token] +lexTokenStream opts buf loc = unP go initState{ options = opts' } + where + new_exts = xunset HaddockBit -- disable Haddock + $ xunset UsePosPragsBit -- parse LINE/COLUMN pragmas as tokens + $ xset RawTokenStreamBit -- include comments + $ pExtsBitmap opts + opts' = opts { pExtsBitmap = new_exts } + initState = initParserState opts' buf loc + go = do + ltok <- lexer False return + case ltok of + L _ ITeof -> return [] + _ -> liftM (ltok:) go linePrags = Map.singleton "line" linePrag ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2660,7 +2660,7 @@ failOpFewArgs (L loc op) = data PV_Context = PV_Context - { pv_options :: ParserFlags + { pv_options :: ParserOpts , pv_hint :: SDoc -- See Note [Parser-Validator Hint] } ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -96,8 +96,8 @@ import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Data.Bag import GHC.Utils.Misc -import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, mkPStatePure) -import GHC.Parser.Lexer (ParserFlags) +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) +import GHC.Parser.Lexer (ParserOpts) import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) import System.Directory @@ -877,14 +877,14 @@ parseName str = withSession $ \hsc_env -> liftIO $ ; hscTcRnLookupRdrName hsc_env lrdr_name } -- | Returns @True@ if passed string is a statement. -isStmt :: ParserFlags -> String -> Bool +isStmt :: ParserOpts -> String -> Bool isStmt pflags stmt = case parseThing Parser.parseStmt pflags stmt of Lexer.POk _ _ -> True Lexer.PFailed _ -> False -- | Returns @True@ if passed string has an import declaration. -hasImport :: ParserFlags -> String -> Bool +hasImport :: ParserOpts -> String -> Bool hasImport pflags stmt = case parseThing Parser.parseModule pflags stmt of Lexer.POk _ thing -> hasImports thing @@ -893,14 +893,14 @@ hasImport pflags stmt = hasImports = not . null . hsmodImports . unLoc -- | Returns @True@ if passed string is an import declaration. -isImport :: ParserFlags -> String -> Bool +isImport :: ParserOpts -> String -> Bool isImport pflags stmt = case parseThing Parser.parseImport pflags stmt of Lexer.POk _ _ -> True Lexer.PFailed _ -> False -- | Returns @True@ if passed string is a declaration but __/not a splice/__. -isDecl :: ParserFlags -> String -> Bool +isDecl :: ParserOpts -> String -> Bool isDecl pflags stmt = do case parseThing Parser.parseDeclaration pflags stmt of Lexer.POk _ thing -> @@ -909,12 +909,12 @@ isDecl pflags stmt = do _ -> True Lexer.PFailed _ -> False -parseThing :: Lexer.P thing -> ParserFlags -> String -> Lexer.ParseResult thing -parseThing parser pflags stmt = do +parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing +parseThing parser opts stmt = do let buf = stringToStringBuffer stmt loc = mkRealSrcLoc (fsLit "") 1 1 - Lexer.unP parser (Lexer.mkPStatePure pflags buf loc) + Lexer.unP parser (Lexer.initParserState opts buf loc) getDocs :: GhcMonad m => Name ===================================== ghc/GHCi/UI.hs ===================================== @@ -50,6 +50,7 @@ import GHC.Driver.Ppr hiding (printForUser) import GHC.Utils.Error hiding (traceCmd) import GHC.Driver.Finder as Finder import GHC.Driver.Monad ( modifySession ) +import GHC.Driver.Config import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc, @@ -1133,7 +1134,7 @@ checkInputForLayout stmt getStmt = do st0 <- getGHCiState let buf' = stringToStringBuffer stmt loc = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1 - pstate = Lexer.mkPState dflags buf' loc + pstate = Lexer.initParserState (initParserOpts dflags) buf' loc case Lexer.unP goToEnd pstate of (Lexer.POk _ False) -> return $ Just stmt _other -> do @@ -1175,7 +1176,7 @@ enqueueCommands cmds = do -- The return value True indicates success, as in `runOneCommand`. runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult) runStmt input step = do - pflags <- Lexer.mkParserFlags <$> GHC.getInteractiveDynFlags + pflags <- initParserOpts <$> GHC.getInteractiveDynFlags -- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes` -- and `-fdefer-out-of-scope-variables` for **naked expressions**. The -- declarations and statements are not affected. ===================================== testsuite/tests/ghc-api/T11579.hs ===================================== @@ -1,5 +1,6 @@ import System.Environment import GHC.Driver.Session +import GHC.Driver.Config import GHC.Data.FastString import GHC import GHC.Data.StringBuffer @@ -16,7 +17,8 @@ main = do hdk_comments <- runGhc (Just libdir) $ do dflags <- getSessionDynFlags - let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc + let opts = initParserOpts (dflags `gopt_set` Opt_Haddock) + pstate = initParserState opts stringBuffer loc case unP (lexer False return) pstate of POk s (L _ ITeof) -> return (map unLoc (toList (hdk_comments s))) _ -> error "No token" ===================================== testsuite/tests/ghc-api/T9015.hs ===================================== @@ -3,7 +3,7 @@ module Main where import GHC import GHC.Driver.Session import GHC.Driver.Monad -import GHC.Parser.Lexer (mkParserFlags) +import GHC.Driver.Config import System.Environment testStrings = [ @@ -53,7 +53,7 @@ main = do where testWithParser parser = do dflags <- getSessionDynFlags - let pflags = mkParserFlags dflags + let pflags = initParserOpts dflags liftIO . putStrLn . unlines $ map (testExpr (parser pflags)) testStrings testExpr parser expr = do ===================================== testsuite/tests/parser/should_run/CountParserDeps.hs ===================================== @@ -28,9 +28,12 @@ main = do [libdir] <- getArgs modules <- parserDeps libdir let num = sizeUniqSet modules --- print num --- print (map moduleNameString $ nonDetEltsUniqSet modules) - unless (num <= 201) $ exitWith (ExitFailure num) + max_num = 201 + min_num = max_num - 10 -- so that we don't forget to change the number + -- when the number of dependencies decreases + -- putStrLn $ "Found " ++ show num ++ " parser module dependencies" + -- forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn + unless (num <= max_num && num >= min_num) $ exitWith (ExitFailure num) parserDeps :: FilePath -> IO (UniqSet ModuleName) parserDeps libdir = ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 37c47822d390b553ce24fe256c9700d5fd83bf9f +Subproject commit a18c3af7f983f3b6d3cd84093c9079031da58468 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e3f00dd24936b6674d0a2322f8410125968583e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e3f00dd24936b6674d0a2322f8410125968583e You're receiving 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 30 06:48:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:48:36 -0400 Subject: [Git][ghc/ghc][master] PmCheck: Long-distance information for LocalBinds (#18626) Message-ID: <5f742a4467ba_80b3f8468f821a015521239@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - + testsuite/tests/pmcheck/should_compile/T18626.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -59,6 +59,7 @@ import GHC.HsToCore.Pmc.Ppr import GHC.Types.Basic (Origin(..)) import GHC.Core (CoreExpr) import GHC.Driver.Session +import GHC.Driver.Types import GHC.Hs import GHC.Types.Id import GHC.Types.SrcLoc @@ -66,11 +67,12 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.Var (EvVar) +import GHC.Tc.Types import GHC.Tc.Utils.TcType (evVarPred) import {-# SOURCE #-} GHC.HsToCore.Expr (dsLExpr) import GHC.HsToCore.Monad import GHC.Data.Bag -import GHC.Data.IOEnv (unsafeInterleaveM) +import GHC.Data.IOEnv (updEnv, unsafeInterleaveM) import GHC.Data.OrdList import GHC.Utils.Monad (mapMaybeM) @@ -95,12 +97,22 @@ getLdiNablas = do True -> pure nablas False -> pure initNablas +-- | We need to call the Hs desugarer to get the Core of a let-binding or where +-- clause. We don't want to run the coverage checker when doing so! Efficiency +-- is one concern, but also a lack of properly set up long-distance information +-- might trigger warnings that we normally wouldn't emit. +noCheckDs :: DsM a -> DsM a +noCheckDs k = do + dflags <- getDynFlags + let dflags' = foldl' wopt_unset dflags allPmCheckWarnings + updEnv (\env -> env{env_top = (env_top env) {hsc_dflags = dflags'} }) k + -- | Check a pattern binding (let, where) for exhaustiveness. pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiNablas - pat_bind <- desugarPatBind loc var p + !missing <- getLdiNablas + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result)) @@ -117,8 +129,8 @@ pmcGRHSs pmcGRHSs 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 <- getLdiNablas + !missing <- getLdiNablas + matches <- noCheckDs $ desugarGRHSs combined_loc empty guards tracePm "pmcGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -126,7 +138,7 @@ pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do result <- unCA (checkGRHSs matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsGRHSs ctxt [] result - return (ldiGRHS <$> cr_ret result) + return (ldiGRHSs (cr_ret result)) -- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each -- with a 'Pat' and one or more 'GRHSs': @@ -153,7 +165,7 @@ pmcMatches 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 <- getLdiNablas + !missing <- getLdiNablas tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -162,13 +174,13 @@ pmcMatches ctxt vars matches = do Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars - empty_case <- desugarEmptyCase var + empty_case <- noCheckDs $ 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 + matches <- noCheckDs $ desugarMatches vars matches result <- unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) formatReportWarnings cirbsMatchGroup ctxt vars result @@ -201,7 +213,10 @@ ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = - (rs_cov red, ldiGRHS <$> grhss) + (rs_cov red, ldiGRHSs grhss) + +ldiGRHSs :: PmGRHSs Post -> NonEmpty Nablas +ldiGRHSs (PmGRHSs { pgs_grhss = grhss }) = ldiGRHS <$> grhss ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red @@ -277,8 +292,8 @@ cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do $ applyWhen (not is_covered) markAllRedundant $ cirb -cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB -cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss +cirbsGRHSs :: PmGRHSs Post -> DsM CIRB +cirbsGRHSs (PmGRHSs { pgs_grhss = grhss }) = Semi.sconcat <$> traverse cirbsGRHS grhss cirbsGRHS :: PmGRHS Post -> DsM CIRB cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -167,8 +167,9 @@ checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) checkMatch (PmMatch { pm_pats = GrdVec grds, pm_grhss = grhss }) = leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) -checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) -checkGRHSs = checkSequence checkGRHS +checkGRHSs :: PmGRHSs Pre -> CheckAction (PmGRHSs Post) +checkGRHSs (PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss }) = + leftToRight PmGRHSs (checkGrds lcls) (checkSequence checkGRHS grhss) checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -26,6 +26,7 @@ import GHC.HsToCore.Pmc.Types import GHC.HsToCore.Pmc.Utils import GHC.Core (Expr(Var,App)) import GHC.Data.FastString (unpackFS, lengthFS) +import GHC.Data.Bag (bagToList) import GHC.Driver.Session import GHC.Hs import GHC.Tc.Utils.Zonk (shortCutLit) @@ -36,6 +37,7 @@ import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Misc import GHC.Core.DataCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion @@ -326,12 +328,14 @@ desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) return PmMatch { pm_pats = GrdVec 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 +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) +desugarGRHSs match_loc pp_pats grhss = do + lcls <- desugarLocalBinds (grhssLocalBinds grhss) + grhss' <- traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + return PmGRHSs { pgs_lcls = GrdVec lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) @@ -351,7 +355,7 @@ desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do desugarGuard :: GuardStmt GhcTc -> DsM [PmGrd] desugarGuard guard = case guard of BodyStmt _ e _ _ -> desugarBoolGuard e - LetStmt _ binds -> desugarLet (unLoc binds) + LetStmt _ binds -> desugarLocalBinds binds BindStmt _ p e -> desugarBind p e LastStmt {} -> panic "desugarGuard LastStmt" ParStmt {} -> panic "desugarGuard ParStmt" @@ -359,9 +363,39 @@ desugarGuard guard = case guard of RecStmt {} -> panic "desugarGuard RecStmt" ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" --- | Desugar let-bindings -desugarLet :: HsLocalBinds GhcTc -> DsM [PmGrd] -desugarLet _binds = return [] +-- | Desugar local bindings to a bunch of 'PmLet' guards. +-- Deals only with simple @let@ or @where@ bindings without any polymorphism, +-- recursion, pattern bindings etc. +-- See Note [Long-distance information for HsLocalBinds]. +desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd] +desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do + concatMapM (concatMapM go . bagToList) (map snd binds) + where + go :: LHsBind GhcTc -> DsM [PmGrd] + go (L _ FunBind{fun_id = L _ x, fun_matches = mg}) + -- See Note [Long-distance information for HsLocalBinds] for why this + -- pattern match is so very specific. + | L _ [L _ Match{m_pats = [], m_grhss = grhss}] <- mg_alts mg + , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + core_rhs <- dsLExpr rhs + return [PmLet x core_rhs] + go (L _ AbsBinds{ abs_tvs = [], abs_ev_vars = [] + , abs_exports=exports, abs_binds = binds }) = do + -- Typechecked HsLocalBinds are wrapped in AbsBinds, which carry + -- renamings. See Note [Long-distance information for HsLocalBinds] + -- for the details. + let go_export :: ABExport GhcTc -> Maybe PmGrd + go_export ABE{abe_poly = x, abe_mono = y, abe_wrap = wrap} + | isIdHsWrapper wrap + = ASSERT2(idType x `eqType` idType y, ppr x $$ ppr (idType x) $$ ppr y $$ ppr (idType y)) + Just $ PmLet x (Var y) + | otherwise + = Nothing + let exps = mapMaybe go_export exports + bs <- concatMapM go (bagToList binds) + return (exps ++ bs) + go _ = return [] +desugarLocalBinds _binds = return [] -- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ @@ -447,4 +481,43 @@ 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. + +Note [Long-distance information for HsLocalBinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#18626) + + f :: Int -> () + f x | y = () + where + y = True + + x :: () + x | let y = True, y = () + +Both definitions are exhaustive, but to make the necessary long-distance +connection from @y@'s binding to its use site in a guard, we have to collect +'PmLet' guards for the 'HsLocalBinds' which contain @y@'s definitions. + +In principle, we are only interested in desugaring local binds that are +'FunBind's, that + + * Have no pattern matches. If @y@ above had any patterns, it would be a + function and we can't reason about them anyway. + * Have singleton match group with a single GRHS. + Otherwise, what expression to pick in the generated guard @let y = @? + +It turns out that desugaring type-checked local binds in this way is a bit +more complex than expected: Apparently, all bindings are wrapped in 'AbsBinds' +Nfter type-checking. See Note [AbsBinds] in "GHC.Hs.Binds". + +We make sure that there is no polymorphism in the way by checking that there +are no 'abs_tvs' or 'abs_ev_vars' (we don't reason about + at y :: forall a. Eq a => ...@) and that the exports carry no 'HsWrapper's. In +this case, the exports are a simple renaming substitution that we can capture +with 'PmLet'. Ultimately we'll hit those renamed 'FunBind's, though, which is +the whole point. + +The place to store the 'PmLet' guards for @where@ clauses (which are per +'GRHSs') is as a field of 'PmGRHSs'. For plain @let@ guards as in the guards of + at x@, we can simply add them to the 'pg_grds' field of 'PmGRHS'. -} ===================================== compiler/GHC/HsToCore/Pmc/Types.hs ===================================== @@ -22,7 +22,7 @@ module GHC.HsToCore.Pmc.Types ( SrcInfo(..), PmGrd(..), GrdVec(..), -- ** Guard tree language - PmMatchGroup(..), PmMatch(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), + PmMatchGroup(..), PmMatch(..), PmGRHSs(..), PmGRHS(..), PmPatBind(..), PmEmptyCase(..), -- * Coverage Checking types RedSets (..), Precision (..), CheckResult (..), @@ -112,7 +112,13 @@ 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)) } +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(PmGRHSs p) } + +-- | A guard tree denoting 'GRHSs': A bunch of 'PmLet' guards for local +-- bindings from the 'GRHSs's @where@ clauses and the actual list of 'GRHS'. +-- See Note [Long-distance information for HsLocalBinds] in +-- "GHC.HsToCore.Pmc.Desugar". +data PmGRHSs p = PmGRHSs { pgs_lcls :: !p, pgs_grhss :: !(NonEmpty (PmGRHS p))} -- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' -- useful for printing out in warnings messages. @@ -149,6 +155,10 @@ instance Outputable p => Outputable (PmMatch p) where ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = ppr grds <+> ppr grhss +instance Outputable p => Outputable (PmGRHSs p) where + ppr (PmGRHSs { pgs_lcls = _lcls, pgs_grhss = grhss }) = + ppr grhss + instance Outputable p => Outputable (PmGRHS p) where ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = ppr grds <+> text "->" <+> ppr rhs ===================================== testsuite/tests/pmcheck/should_compile/T18626.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} + +module Lib where + +x :: () +x | let y = True, y = () + +f :: Int -> () +f _ | y = () + where + y = True ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -148,6 +148,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('T18626', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) test('T18609', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ab0d8f77ec67676de40ebe6ff7e86756e5c761e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ab0d8f77ec67676de40ebe6ff7e86756e5c761e You're receiving 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 30 06:49:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:49:49 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Remove unsafeGlobalDynFlags (#17957, #14597) Message-ID: <5f742a8d423dd_80b3f843510d4cc15526773@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 17 changed files: - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Utils/Error.hs - + compiler/GHC/Utils/GlobalVars.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Panic.hs - compiler/HsVersions.h - compiler/ghc.cabal.in - includes/rts/Globals.h - rts/Globals.c - rts/RtsSymbols.c - testsuite/tests/plugins/LinkerTicklingPlugin.hs - testsuite/tests/plugins/all.T Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -1156,7 +1156,8 @@ tryUnfolding dflags id lone_variable , extra_doc , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"] - str = "Considering inlining: " ++ showSDocDump dflags (ppr id) + ctx = initSDocContext dflags defaultDumpStyle + str = "Considering inlining: " ++ showSDocDump ctx (ppr id) n_val_args = length arg_infos -- some_benefit is used when the RHS is small enough ===================================== compiler/GHC/Driver/Ppr.hs ===================================== @@ -29,6 +29,7 @@ import GHC.Utils.Exception import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.GlobalVars import GHC.Utils.Ppr ( Mode(..) ) import {-# SOURCE #-} GHC.Unit.State @@ -43,7 +44,7 @@ showPpr :: Outputable a => DynFlags -> a -> String showPpr dflags thing = showSDoc dflags (ppr thing) showPprUnsafe :: Outputable a => a -> String -showPprUnsafe a = showPpr unsafeGlobalDynFlags a +showPprUnsafe a = renderWithContext defaultSDocContext (ppr a) -- | Allows caller to specify the PrintUnqualified to use showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String @@ -53,8 +54,8 @@ showSDocForUser dflags unqual doc = renderWithContext (initSDocContext dflags st unit_state = unitState dflags doc' = pprWithUnitState unit_state doc -showSDocDump :: DynFlags -> SDoc -> String -showSDocDump dflags d = renderWithContext (initSDocContext dflags defaultDumpStyle) d +showSDocDump :: SDocContext -> SDoc -> String +showSDocDump ctx d = renderWithContext ctx (withPprStyle defaultDumpStyle d) showSDocDebug :: DynFlags -> SDoc -> String showSDocDebug dflags d = renderWithContext ctx d @@ -75,9 +76,9 @@ printForC dflags handle doc = printSDocLn ctx LeftMode handle doc where ctx = initSDocContext dflags (PprCode CStyle) -pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a -pprDebugAndThen dflags cont heading pretty_msg - = cont (showSDocDump dflags doc) +pprDebugAndThen :: SDocContext -> (String -> a) -> SDoc -> SDoc -> a +pprDebugAndThen ctx cont heading pretty_msg + = cont (showSDocDump ctx doc) where doc = sep [heading, nest 2 pretty_msg] @@ -85,19 +86,22 @@ pprDebugAndThen dflags cont heading pretty_msg pprTraceWithFlags :: DynFlags -> String -> SDoc -> a -> a pprTraceWithFlags dflags str doc x | hasNoDebugOutput dflags = x - | otherwise = pprDebugAndThen dflags trace (text str) doc x + | otherwise = pprDebugAndThen (initSDocContext dflags defaultDumpStyle) + trace (text str) doc x -- | If debug output is on, show some 'SDoc' on the screen pprTrace :: String -> SDoc -> a -> a -pprTrace str doc x = pprTraceWithFlags unsafeGlobalDynFlags str doc x +pprTrace str doc x + | unsafeHasNoDebugOutput = x + | otherwise = pprDebugAndThen defaultSDocContext trace (text str) doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) pprTraceDebug :: String -> SDoc -> a -> a pprTraceDebug str doc x - | debugIsOn && hasPprDebug unsafeGlobalDynFlags = pprTrace str doc x - | otherwise = x + | debugIsOn && unsafeHasPprDebug = pprTrace str doc x + | otherwise = x -- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x at . -- This allows you to print details from the returned value as well as from @@ -114,7 +118,7 @@ pprTraceIt desc x = pprTraceWith desc ppr x pprTraceException :: ExceptionMonad m => String -> SDoc -> m a -> m a pprTraceException heading doc = handleGhcException $ \exc -> liftIO $ do - putStrLn $ showSDocDump unsafeGlobalDynFlags (sep [text heading, nest 2 doc]) + putStrLn $ showSDocDump defaultSDocContext (sep [text heading, nest 2 doc]) throwGhcExceptionIO exc -- | If debug output is on, show some 'SDoc' on the screen along @@ -127,10 +131,10 @@ warnPprTrace :: HasCallStack => Bool -> String -> Int -> SDoc -> a -> a -- Should typically be accessed with the WARN macros warnPprTrace _ _ _ _ x | not debugIsOn = x warnPprTrace _ _file _line _msg x - | hasNoDebugOutput unsafeGlobalDynFlags = x + | unsafeHasNoDebugOutput = x warnPprTrace False _file _line _msg x = x warnPprTrace True file line msg x - = pprDebugAndThen unsafeGlobalDynFlags trace heading + = pprDebugAndThen defaultSDocContext trace heading (msg $$ callStackDoc ) x where ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -15,8 +15,6 @@ -- ------------------------------------------------------------------------------- -{-# OPTIONS_GHC -fno-cse #-} --- -fno-cse is needed for GLOBAL_VAR's to behave properly {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Driver.Session ( @@ -199,7 +197,7 @@ module GHC.Driver.Session ( wordAlignment, - unsafeGlobalDynFlags, setUnsafeGlobalDynFlags, + setUnsafeGlobalDynFlags, -- * SSE and AVX isSseEnabled, @@ -256,6 +254,7 @@ import GHC.Settings.Constants import GHC.Utils.Panic import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Misc +import GHC.Utils.GlobalVars import GHC.Data.Maybe import GHC.Utils.Monad import qualified GHC.Utils.Ppr as Pretty @@ -275,7 +274,6 @@ import GHC.Utils.Json import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) -import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef import Control.Arrow ((&&&)) import Control.Monad @@ -305,11 +303,6 @@ import qualified GHC.Data.EnumSet as EnumSet import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -#if GHC_STAGE >= 2 --- used by SHARED_GLOBAL_VAR -import Foreign (Ptr) -#endif - -- Note [Updating flag description in the User's Guide] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- @@ -4892,40 +4885,12 @@ makeDynFlagsConsistent dflags os = platformOS platform --------------------------------------------------------------------------- --- Do not use unsafeGlobalDynFlags! --- --- unsafeGlobalDynFlags is a hack, necessary because we need to be able --- to show SDocs when tracing, but we don't always have DynFlags --- available. --- --- Do not use it if you can help it. You may get the wrong value, or this --- panic! - --- | This is the value that 'unsafeGlobalDynFlags' takes before it is --- initialized. -defaultGlobalDynFlags :: DynFlags -defaultGlobalDynFlags = - (defaultDynFlags settings llvmConfig) { verbosity = 2 } - where - settings = panic "v_unsafeGlobalDynFlags: settings not initialised" - llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised" - -#if GHC_STAGE < 2 -GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) -#else -SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags - , getOrSetLibHSghcGlobalDynFlags - , "getOrSetLibHSghcGlobalDynFlags" - , defaultGlobalDynFlags - , DynFlags ) -#endif - -unsafeGlobalDynFlags :: DynFlags -unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags - setUnsafeGlobalDynFlags :: DynFlags -> IO () -setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags +setUnsafeGlobalDynFlags dflags = do + writeIORef v_unsafeHasPprDebug (hasPprDebug dflags) + writeIORef v_unsafeHasNoDebugOutput (hasNoDebugOutput dflags) + writeIORef v_unsafeHasNoStateHack (hasNoStateHack dflags) + -- ----------------------------------------------------------------------------- -- SSE and AVX ===================================== compiler/GHC/Driver/Session.hs-boot ===================================== @@ -9,7 +9,6 @@ data DynFlags targetPlatform :: DynFlags -> Platform unitState :: DynFlags -> UnitState -unsafeGlobalDynFlags :: DynFlags hasPprDebug :: DynFlags -> Bool hasNoDebugOutput :: DynFlags -> Bool initSDocContext :: DynFlags -> PprStyle -> SDocContext ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -755,14 +755,15 @@ link_caf node = do -- name of the data constructor itself. Otherwise it is determined by -- @closureDescription@ from the let binding information. -closureDescription :: DynFlags - -> Module -- Module - -> Name -- Id of closure binding - -> String +closureDescription + :: DynFlags + -> Module -- Module + -> Name -- Id of closure binding + -> String -- Not called for StgRhsCon which have global info tables built in -- CgConTbls.hs with a description generated from the data constructor closureDescription dflags mod_name name - = showSDocDump dflags (char '<' <> + = showSDocDump (initSDocContext dflags defaultDumpStyle) (char '<' <> (if isExternalName name then ppr name -- ppr will include the module name prefix else pprModule mod_name <> char '.' <> ppr name) <> ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -123,7 +123,6 @@ module GHC.Types.Id ( import GHC.Prelude -import GHC.Driver.Session import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding, isCompulsoryUnfolding, Unfolding( NoUnfolding ) ) @@ -161,6 +160,7 @@ import GHC.Core.Multiplicity import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.GlobalVars import GHC.Driver.Ppr @@ -843,7 +843,7 @@ typeOneShot ty isStateHackType :: Type -> Bool isStateHackType ty - | hasNoStateHack unsafeGlobalDynFlags + | unsafeHasNoStateHack = False | otherwise = case tyConAppTyCon_maybe ty of ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -820,13 +820,15 @@ prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a prettyPrintGhcErrors dflags = MC.handle $ \e -> case e of PprPanic str doc -> - pprDebugAndThen dflags panic (text str) doc + pprDebugAndThen ctx panic (text str) doc PprSorry str doc -> - pprDebugAndThen dflags sorry (text str) doc + pprDebugAndThen ctx sorry (text str) doc PprProgramError str doc -> - pprDebugAndThen dflags pgmError (text str) doc + pprDebugAndThen ctx pgmError (text str) doc _ -> liftIO $ throwIO e + where + ctx = initSDocContext dflags defaultUserStyle -- | Checks if given 'WarnMsg' is a fatal warning. isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag) ===================================== compiler/GHC/Utils/GlobalVars.hs ===================================== @@ -0,0 +1,112 @@ +{-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-cse #-} +-- -fno-cse is needed for GLOBAL_VAR's to behave properly + +module GHC.Utils.GlobalVars + ( v_unsafeHasPprDebug + , v_unsafeHasNoDebugOutput + , v_unsafeHasNoStateHack + , unsafeHasPprDebug + , unsafeHasNoDebugOutput + , unsafeHasNoStateHack + + , global + , consIORef + , globalM + , sharedGlobal + , sharedGlobalM + ) +where + +#include "HsVersions.h" + +import GHC.Prelude + +import GHC.Conc.Sync ( sharedCAF ) + +import System.IO.Unsafe +import Data.IORef +import Foreign (Ptr) + + +-------------------------------------------------------------------------- +-- Do not use global variables! +-- +-- Global variables are a hack. Do not use them if you can help it. + +#if GHC_STAGE < 2 + +GLOBAL_VAR(v_unsafeHasPprDebug, False, Bool) +GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool) +GLOBAL_VAR(v_unsafeHasNoStateHack, False, Bool) + +#else +SHARED_GLOBAL_VAR( v_unsafeHasPprDebug + , getOrSetLibHSghcGlobalHasPprDebug + , "getOrSetLibHSghcGlobalHasPprDebug" + , False + , Bool ) +SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput + , getOrSetLibHSghcGlobalHasNoDebugOutput + , "getOrSetLibHSghcGlobalHasNoDebugOutput" + , False + , Bool ) +SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack + , getOrSetLibHSghcGlobalHasNoStateHack + , "getOrSetLibHSghcGlobalHasNoStateHack" + , False + , Bool ) +#endif + +unsafeHasPprDebug :: Bool +unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug + +unsafeHasNoDebugOutput :: Bool +unsafeHasNoDebugOutput = unsafePerformIO $ readIORef v_unsafeHasNoDebugOutput + +unsafeHasNoStateHack :: Bool +unsafeHasNoStateHack = unsafePerformIO $ readIORef v_unsafeHasNoStateHack + +{- +************************************************************************ +* * + Globals and the RTS +* * +************************************************************************ + +When a plugin is loaded, it currently gets linked against a *newly +loaded* copy of the GHC package. This would not be a problem, except +that the new copy has its own mutable state that is not shared with +that state that has already been initialized by the original GHC +package. + +(Note that if the GHC executable was dynamically linked this +wouldn't be a problem, because we could share the GHC library it +links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.) + +The solution is to make use of @sharedCAF@ through @sharedGlobal@ +for globals that are shared between multiple copies of ghc packages. +-} + +-- Global variables: + +global :: a -> IORef a +global a = unsafePerformIO (newIORef a) + +consIORef :: IORef [a] -> a -> IO () +consIORef var x = do + atomicModifyIORef' var (\xs -> (x:xs,())) + +globalM :: IO a -> IORef a +globalM ma = unsafePerformIO (ma >>= newIORef) + +-- Shared global variables: + +sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a +sharedGlobal a get_or_set = unsafePerformIO $ + newIORef a >>= flip sharedCAF get_or_set + +sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a +sharedGlobalM ma get_or_set = unsafePerformIO $ + ma >>= newIORef >>= flip sharedCAF get_or_set ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -107,9 +107,6 @@ module GHC.Utils.Misc ( modificationTimeIfExists, withAtomicRename, - global, consIORef, globalM, - sharedGlobal, sharedGlobalM, - -- * Filenames and paths Suffix, splitLongestPrefix, @@ -143,8 +140,6 @@ import GHC.Utils.Exception import GHC.Utils.Panic.Plain import Data.Data -import Data.IORef ( IORef, newIORef, atomicModifyIORef' ) -import System.IO.Unsafe ( unsafePerformIO ) import Data.List hiding (group) import Data.List.NonEmpty ( NonEmpty(..) ) @@ -154,7 +149,6 @@ import GHC.Stack (HasCallStack) import Control.Applicative ( liftA2 ) import Control.Monad ( liftM, guard ) import Control.Monad.IO.Class ( MonadIO, liftIO ) -import GHC.Conc.Sync ( sharedCAF ) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime, renameFile ) import System.FilePath @@ -1070,48 +1064,6 @@ strictMap f (x : xs) = in x' : xs' -{- -************************************************************************ -* * - Globals and the RTS -* * -************************************************************************ - -When a plugin is loaded, it currently gets linked against a *newly -loaded* copy of the GHC package. This would not be a problem, except -that the new copy has its own mutable state that is not shared with -that state that has already been initialized by the original GHC -package. - -(Note that if the GHC executable was dynamically linked this -wouldn't be a problem, because we could share the GHC library it -links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.) - -The solution is to make use of @sharedCAF@ through @sharedGlobal@ -for globals that are shared between multiple copies of ghc packages. --} - --- Global variables: - -global :: a -> IORef a -global a = unsafePerformIO (newIORef a) - -consIORef :: IORef [a] -> a -> IO () -consIORef var x = do - atomicModifyIORef' var (\xs -> (x:xs,())) - -globalM :: IO a -> IORef a -globalM ma = unsafePerformIO (ma >>= newIORef) - --- Shared global variables: - -sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a -sharedGlobal a get_or_set = unsafePerformIO $ - newIORef a >>= flip sharedCAF get_or_set - -sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a -sharedGlobalM ma get_or_set = unsafePerformIO $ - ma >>= newIORef >>= flip sharedCAF get_or_set -- Module names: ===================================== compiler/GHC/Utils/Panic.hs ===================================== @@ -47,8 +47,6 @@ import GHC.Prelude import GHC.Stack import GHC.Utils.Outputable -import {-# SOURCE #-} GHC.Driver.Session (DynFlags, unsafeGlobalDynFlags) -import {-# SOURCE #-} GHC.Driver.Ppr (showSDoc) import GHC.Utils.Panic.Plain import GHC.Utils.Exception as Exception @@ -146,16 +144,14 @@ safeShowException e = do -- | Append a description of the given exception to this string. -- --- Note that this uses 'GHC.Driver.Session.unsafeGlobalDynFlags', which may have some --- uninitialized fields if invoked before 'GHC.initGhcMonad' has been called. --- If the error message to be printed includes a pretty-printer document --- which forces one of these fields this call may bottom. +-- Note that this uses 'defaultSDocContext', which doesn't use the options +-- set by the user via DynFlags. showGhcExceptionUnsafe :: GhcException -> ShowS -showGhcExceptionUnsafe = showGhcException unsafeGlobalDynFlags +showGhcExceptionUnsafe = showGhcException defaultSDocContext -- | Append a description of the given exception to this string. -showGhcException :: DynFlags -> GhcException -> ShowS -showGhcException dflags = showPlainGhcException . \case +showGhcException :: SDocContext -> GhcException -> ShowS +showGhcException ctx = showPlainGhcException . \case Signal n -> PlainSignal n UsageError str -> PlainUsageError str CmdLineError str -> PlainCmdLineError str @@ -165,11 +161,11 @@ showGhcException dflags = showPlainGhcException . \case ProgramError str -> PlainProgramError str PprPanic str sdoc -> PlainPanic $ - concat [str, "\n\n", showSDoc dflags sdoc] + concat [str, "\n\n", renderWithContext ctx sdoc] PprSorry str sdoc -> PlainProgramError $ - concat [str, "\n\n", showSDoc dflags sdoc] + concat [str, "\n\n", renderWithContext ctx sdoc] PprProgramError str sdoc -> PlainProgramError $ - concat [str, "\n\n", showSDoc dflags sdoc] + concat [str, "\n\n", renderWithContext ctx sdoc] throwGhcException :: GhcException -> a throwGhcException = Exception.throw ===================================== compiler/HsVersions.h ===================================== @@ -15,25 +15,25 @@ you will screw up the layout where they are used in case expressions! #define GLOBAL_VAR(name,value,ty) \ {-# NOINLINE name #-}; \ name :: IORef (ty); \ -name = GHC.Utils.Misc.global (value); +name = GHC.Utils.GlobalVars.global (value); #define GLOBAL_VAR_M(name,value,ty) \ {-# NOINLINE name #-}; \ name :: IORef (ty); \ -name = GHC.Utils.Misc.globalM (value); +name = GHC.Utils.GlobalVars.globalM (value); #define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \ {-# NOINLINE name #-}; \ name :: IORef (ty); \ -name = GHC.Utils.Misc.sharedGlobal (value) (accessor); \ +name = GHC.Utils.GlobalVars.sharedGlobal (value) (accessor);\ foreign import ccall unsafe saccessor \ accessor :: Ptr (IORef a) -> IO (Ptr (IORef a)); #define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty) \ {-# NOINLINE name #-}; \ name :: IORef (ty); \ -name = GHC.Utils.Misc.sharedGlobalM (value) (accessor); \ +name = GHC.Utils.GlobalVars.sharedGlobalM (value) (accessor); \ foreign import ccall unsafe saccessor \ accessor :: Ptr (IORef a) -> IO (Ptr (IORef a)); ===================================== compiler/ghc.cabal.in ===================================== @@ -177,6 +177,7 @@ Library GHC.Types.Cpr GHC.Cmm.DebugBlock GHC.Utils.Exception + GHC.Utils.GlobalVars GHC.Types.FieldLabel GHC.Driver.Monad GHC.Driver.Hooks ===================================== includes/rts/Globals.h ===================================== @@ -29,8 +29,6 @@ mkStoreAccessorPrototype(SystemEventThreadIOManagerThreadStore) mkStoreAccessorPrototype(SystemTimerThreadEventManagerStore) mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore) mkStoreAccessorPrototype(LibHSghcFastStringTable) -mkStoreAccessorPrototype(LibHSghcPersistentLinkerState) -mkStoreAccessorPrototype(LibHSghcInitLinkerDone) -mkStoreAccessorPrototype(LibHSghcGlobalDynFlags) -mkStoreAccessorPrototype(LibHSghcStaticOptions) -mkStoreAccessorPrototype(LibHSghcStaticOptionsReady) +mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug) +mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput) +mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack) ===================================== rts/Globals.c ===================================== @@ -33,11 +33,9 @@ typedef enum { SystemTimerThreadEventManagerStore, SystemTimerThreadIOManagerThreadStore, LibHSghcFastStringTable, - LibHSghcPersistentLinkerState, - LibHSghcInitLinkerDone, - LibHSghcGlobalDynFlags, - LibHSghcStaticOptions, - LibHSghcStaticOptionsReady, + LibHSghcGlobalHasPprDebug, + LibHSghcGlobalHasNoDebugOutput, + LibHSghcGlobalHasNoStateHack, MaxStoreKey } StoreKey; @@ -106,8 +104,6 @@ mkStoreAccessor(SystemEventThreadIOManagerThreadStore) mkStoreAccessor(SystemTimerThreadEventManagerStore) mkStoreAccessor(SystemTimerThreadIOManagerThreadStore) mkStoreAccessor(LibHSghcFastStringTable) -mkStoreAccessor(LibHSghcPersistentLinkerState) -mkStoreAccessor(LibHSghcInitLinkerDone) -mkStoreAccessor(LibHSghcGlobalDynFlags) -mkStoreAccessor(LibHSghcStaticOptions) -mkStoreAccessor(LibHSghcStaticOptionsReady) +mkStoreAccessor(LibHSghcGlobalHasPprDebug) +mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput) +mkStoreAccessor(LibHSghcGlobalHasNoStateHack) ===================================== rts/RtsSymbols.c ===================================== @@ -642,9 +642,9 @@ SymI_HasProto(getOrSetLibHSghcFastStringTable) \ SymI_HasProto(getRTSStats) \ SymI_HasProto(getRTSStatsEnabled) \ - SymI_HasProto(getOrSetLibHSghcPersistentLinkerState) \ - SymI_HasProto(getOrSetLibHSghcInitLinkerDone) \ - SymI_HasProto(getOrSetLibHSghcGlobalDynFlags) \ + SymI_HasProto(getOrSetLibHSghcGlobalHasPprDebug) \ + SymI_HasProto(getOrSetLibHSghcGlobalHasNoDebugOutput) \ + SymI_HasProto(getOrSetLibHSghcGlobalHasNoStateHack) \ SymI_HasProto(genericRaise) \ SymI_HasProto(getProgArgv) \ SymI_HasProto(getFullProgArgv) \ ===================================== testsuite/tests/plugins/LinkerTicklingPlugin.hs ===================================== @@ -2,14 +2,19 @@ module LinkerTicklingPlugin where import GHC.Plugins import GHC.Driver.Session +import GHC.Utils.GlobalVars plugin :: Plugin -plugin = defaultPlugin { - installCoreToDos = install - } +plugin = defaultPlugin + { installCoreToDos = install + } -- This tests whether plugins are linking against the *running* GHC or a new -- instance of it. If it is a new instance (settings unsafeGlobalDynFlags) won't -- have been initialised, so we'll get a GHC panic here: install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] -install _options todos = settings unsafeGlobalDynFlags `seq` return todos +install _options todos = io `seq` return todos + where + io = if not unsafeHasPprDebug + then error "unsafePprDebug should be set: plugin linked against a different GHC?" + else () ===================================== testsuite/tests/plugins/all.T ===================================== @@ -44,7 +44,7 @@ test('plugins06', [extra_files(['LinkerTicklingPlugin.hs']), unless(have_dynamic(), skip), only_ways([config.ghc_plugin_way])], - multimod_compile_and_run, ['plugins06', '-package ghc']) + multimod_compile_and_run, ['plugins06', '-package ghc -dppr-debug']) test('plugins07', [extra_files(['rule-defining-plugin/']), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6527fc57b8e099703f5bdb5ec7f1dfd421651972...9befd94d79a78fd53a28a4ce051a91d2215d069c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6527fc57b8e099703f5bdb5ec7f1dfd421651972...9befd94d79a78fd53a28a4ce051a91d2215d069c You're receiving 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 30 06:49:11 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:49:11 -0400 Subject: [Git][ghc/ghc][master] 2 commits: testsuite: Mark T12971 as broken on Windows Message-ID: <5f742a67588ef_80b3f8428525ea41552547@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - 8 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - hadrian/src/Rules/Generate.hs - libraries/Cabal - libraries/directory - libraries/process - testsuite/tests/driver/all.T - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -76,7 +76,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.10 + Build-Depends: Win32 >= 2.3 && < 2.11 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.10 + Build-Depends: Win32 >= 2.3 && < 2.11 else Build-Depends: unix >= 2.7 && < 2.9 ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -166,7 +166,7 @@ copyRules = do prefix -/- "ghci-usage.txt" <~ return "driver" prefix -/- "llvm-targets" <~ return "." prefix -/- "llvm-passes" <~ return "." - prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs) + prefix -/- "template-hsc.h" <~ return (pkgPath hsc2hs -/- "data") prefix -/- "html/**" <~ return "utils/haddock/haddock-api/resources" prefix -/- "latex/**" <~ return "utils/haddock/haddock-api/resources" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 5139d6e72d391bffa3cf06f08884277799eb0b45 +Subproject commit 5aea8a4b8463e1ae95272e190a1022764164294f ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e +Subproject commit b697b3ea77dd4803f2f8f676dd64c8ea5277fcf0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 +Subproject commit 72c6be917064c923e365622032d1f2fa07acb5eb ===================================== testsuite/tests/driver/all.T ===================================== @@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, makefile_test, []) -test('T12971', ignore_stdout, makefile_test, []) +test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, []) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json']) test('T16167', exit_code(1), run_command, ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit 7accbea001bcac638c4320d3755af29478114901 +Subproject commit 9cacd5d465d5797e4935d1aa6ae6a71488a03938 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab0d8f77ec67676de40ebe6ff7e86756e5c761e...6527fc57b8e099703f5bdb5ec7f1dfd421651972 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab0d8f77ec67676de40ebe6ff7e86756e5c761e...6527fc57b8e099703f5bdb5ec7f1dfd421651972 You're receiving 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 30 06:50:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:50:25 -0400 Subject: [Git][ghc/ghc][master] Omit redundant kind equality check in solver Message-ID: <5f742ab1c5050_80b3f84399c0b9c155318dc@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 1 changed file: - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2357,10 +2357,8 @@ lookupFlatCache fam_tc tys lookup_flats flat_cache]) } where lookup_inerts inert_funeqs - | Just (CFunEqCan { cc_ev = ctev, cc_fsk = fsk, cc_tyargs = xis }) + | Just (CFunEqCan { cc_ev = ctev, cc_fsk = fsk }) <- findFunEq inert_funeqs fam_tc tys - , tys `eqTypes` xis -- The lookup might find a near-match; see - -- Note [Use loose types in inert set] = Just (ctEvCoercion ctev, mkTyVarTy fsk, ctEvFlavour ctev) | otherwise = Nothing @@ -2377,16 +2375,14 @@ lookupInInerts loc pty | otherwise -- NB: No caching for equalities, IPs, holes, or errors = return Nothing --- | Look up a dictionary inert. NB: the returned 'CtEvidence' might not --- match the input exactly. Note [Use loose types in inert set]. +-- | Look up a dictionary inert. lookupInertDict :: InertCans -> CtLoc -> Class -> [Type] -> Maybe CtEvidence lookupInertDict (IC { inert_dicts = dicts }) loc cls tys = case findDict dicts loc cls tys of Just ct -> Just (ctEvidence ct) _ -> Nothing --- | Look up a solved inert. NB: the returned 'CtEvidence' might not --- match the input exactly. See Note [Use loose types in inert set]. +-- | Look up a solved inert. lookupSolvedDict :: InertSet -> CtLoc -> Class -> [Type] -> Maybe CtEvidence -- Returns just if exactly this predicate type exists in the solved. lookupSolvedDict (IS { inert_solved_dicts = solved }) loc cls tys @@ -2412,12 +2408,24 @@ foldIrreds k irreds z = foldr k z irreds Note [Use loose types in inert set] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Say we know (Eq (a |> c1)) and we need (Eq (a |> c2)). One is clearly -solvable from the other. So, we do lookup in the inert set using -loose types, which omit the kind-check. - -We must be careful when using the result of a lookup because it may -not match the requested info exactly! +Whenever we are looking up an inert dictionary (CDictCan) or function +equality (CFunEqCan), we use a TcAppMap, which uses the Unique of the +class/type family tycon and then a trie which maps the arguments. This +trie does *not* need to match the kinds of the arguments; this Note +explains why. + +Consider the types ty0 = (T ty1 ty2 ty3 ty4) and ty0' = (T ty1' ty2' ty3' ty4'), +where ty4 and ty4' have different kinds. Let's further assume that both types +ty0 and ty0' are well-typed. Because the kind of T is closed, it must be that +one of the ty1..ty3 does not match ty1'..ty3' (and that the kind of the fourth +argument to T is dependent on whichever one changed). Since we are matching +all arguments, during the inert-set lookup, we know that ty1..ty3 do indeed +match ty1'..ty3'. Therefore, the kind of ty4 and ty4' must match, too -- +without ever looking at it. + +Accordingly, we use LooseTypeMap, which skips the kind check when looking +up a type. I (Richard E) believe this is just an optimization, and that +looking at kinds would be harmless. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c98699f685d8c53fd594b6de22b425ed951174f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c98699f685d8c53fd594b6de22b425ed951174f You're receiving 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 30 06:51:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:51:00 -0400 Subject: [Git][ghc/ghc][master] Pmc: Don't call exprType on type arguments (#18767) Message-ID: <5f742ad4dc3a3_80b3f84399c0b9c15535959@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 1 changed file: - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -62,6 +62,7 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Solver.Monad (InertSet, emptyInert) +import GHC.Tc.Utils.TcType (isStringTy) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -562,7 +563,7 @@ coreExprAsPmLit e = case collectArgs e of (Var x, args) | is_rebound_name x fromStringName -- See Note [Detecting overloaded literals with -XRebindableSyntax] - , s:_ <- filter (eqType stringTy . exprType) args + , s:_ <- filter (isStringTy . exprType) $ filter isValArg args -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings -> coreExprAsPmLit s >>= overloadPmLit (exprType e) -- These last two cases handle proper String literals View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395498260ab444f5e1ec82d716bea3cc3ad887f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/395498260ab444f5e1ec82d716bea3cc3ad887f7 You're receiving 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 30 06:51:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 30 Sep 2020 02:51:37 -0400 Subject: [Git][ghc/ghc][master] Regression test for #10709. Message-ID: <5f742af92467c_80b78e75b815540035@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 5 changed files: - + testsuite/tests/typecheck/should_fail/T10709.hs - + testsuite/tests/typecheck/should_fail/T10709.stderr - + testsuite/tests/typecheck/should_fail/T10709b.hs - + testsuite/tests/typecheck/should_fail/T10709b.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== testsuite/tests/typecheck/should_fail/T10709.hs ===================================== @@ -0,0 +1,8 @@ +module T10709 where + +import GHC.IO +import Control.Monad + +x1 = replicateM 2 . mask +x2 = (replicateM 2 . mask) undefined +x3 = (replicateM 2 . mask) $ undefined ===================================== testsuite/tests/typecheck/should_fail/T10709.stderr ===================================== @@ -0,0 +1,34 @@ + +T10709.hs:6:21: error: + • Couldn't match type ‘a4’ with ‘(forall a. IO a -> IO a) -> IO a5’ + Expected: a4 -> IO a5 + Actual: ((forall a. IO a -> IO a) -> IO a5) -> IO a5 + Cannot instantiate unification variable ‘a4’ + with a type involving polytypes: (forall a. IO a -> IO a) -> IO a5 + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: replicateM 2 . mask + In an equation for ‘x1’: x1 = replicateM 2 . mask + • Relevant bindings include + x1 :: a4 -> IO [a5] (bound at T10709.hs:6:1) + +T10709.hs:7:22: error: + • Couldn't match type ‘a2’ with ‘(forall a. IO a -> IO a) -> IO a3’ + Expected: a2 -> IO a3 + Actual: ((forall a. IO a -> IO a) -> IO a3) -> IO a3 + Cannot instantiate unification variable ‘a2’ + with a type involving polytypes: (forall a. IO a -> IO a) -> IO a3 + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: (replicateM 2 . mask) undefined + In an equation for ‘x2’: x2 = (replicateM 2 . mask) undefined + • Relevant bindings include x2 :: IO [a3] (bound at T10709.hs:7:1) + +T10709.hs:8:22: error: + • Couldn't match type ‘a0’ with ‘(forall a. IO a -> IO a) -> IO a1’ + Expected: a0 -> IO a1 + Actual: ((forall a. IO a -> IO a) -> IO a1) -> IO a1 + Cannot instantiate unification variable ‘a0’ + with a type involving polytypes: (forall a. IO a -> IO a) -> IO a1 + • In the second argument of ‘(.)’, namely ‘mask’ + In the first argument of ‘($)’, namely ‘(replicateM 2 . mask)’ + In the expression: (replicateM 2 . mask) $ undefined + • Relevant bindings include x3 :: IO [a1] (bound at T10709.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/T10709b.hs ===================================== @@ -0,0 +1,10 @@ +module T10709b where + +import GHC.IO +import Control.Monad + +x4 = (replicateM 2 . mask) (\_ -> return ()) +x5 = (replicateM 2 . mask) (\x -> undefined x) +x6 = (replicateM 2 . mask) (id (\_ -> undefined)) +x7 = (replicateM 2 . mask) (const undefined) +x8 = (replicateM 2 . mask) ((\x -> undefined x) :: a -> b) ===================================== testsuite/tests/typecheck/should_fail/T10709b.stderr ===================================== @@ -0,0 +1,56 @@ + +T10709b.hs:6:22: error: + • Couldn't match type ‘p1’ with ‘forall a. IO a -> IO a’ + Expected: (p1 -> IO ()) -> IO () + Actual: ((forall a. IO a -> IO a) -> IO ()) -> IO () + Cannot instantiate unification variable ‘p1’ + with a type involving polytypes: forall a. IO a -> IO a + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: (replicateM 2 . mask) (\ _ -> return ()) + In an equation for ‘x4’: + x4 = (replicateM 2 . mask) (\ _ -> return ()) + +T10709b.hs:7:22: error: + • Couldn't match type ‘t0’ with ‘forall a. IO a -> IO a’ + Expected: (t0 -> IO a) -> IO a + Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a + Cannot instantiate unification variable ‘t0’ + with a type involving polytypes: forall a. IO a -> IO a + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: (replicateM 2 . mask) (\ x -> undefined x) + In an equation for ‘x5’: + x5 = (replicateM 2 . mask) (\ x -> undefined x) + +T10709b.hs:8:22: error: + • Couldn't match type ‘p0’ with ‘forall a. IO a -> IO a’ + Expected: (p0 -> IO a) -> IO a + Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a + Cannot instantiate unification variable ‘p0’ + with a type involving polytypes: forall a. IO a -> IO a + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: (replicateM 2 . mask) (id (\ _ -> undefined)) + In an equation for ‘x6’: + x6 = (replicateM 2 . mask) (id (\ _ -> undefined)) + +T10709b.hs:9:22: error: + • Couldn't match type ‘b0’ with ‘forall a. IO a -> IO a’ + Expected: (b0 -> IO a) -> IO a + Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a + Cannot instantiate unification variable ‘b0’ + with a type involving polytypes: forall a. IO a -> IO a + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: (replicateM 2 . mask) (const undefined) + In an equation for ‘x7’: + x7 = (replicateM 2 . mask) (const undefined) + +T10709b.hs:10:22: error: + • Couldn't match type ‘a0’ with ‘forall a. IO a -> IO a’ + Expected: (a0 -> IO a) -> IO a + Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a + Cannot instantiate unification variable ‘a0’ + with a type involving polytypes: forall a. IO a -> IO a + • In the second argument of ‘(.)’, namely ‘mask’ + In the expression: + (replicateM 2 . mask) ((\ x -> undefined x) :: a -> b) + In an equation for ‘x8’: + x8 = (replicateM 2 . mask) ((\ x -> undefined x) :: a -> b) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -584,3 +584,5 @@ test('too-many', normal, compile_fail, ['']) test('T18640a', normal, compile_fail, ['']) test('T18640b', normal, compile_fail, ['']) test('T18640c', normal, compile_fail, ['']) +test('T10709', normal, compile_fail, ['']) +test('T10709b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/235e410f63a4725bbc4466dbdef7d5f661793e84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/235e410f63a4725bbc4466dbdef7d5f661793e84 You're receiving 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 30 08:22:59 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 04:22:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/strict-ttg Message-ID: <5f744063623d4_80ba9d5b4815546363@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/strict-ttg at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/strict-ttg You're receiving 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 30 08:55:41 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 04:55:41 -0400 Subject: [Git][ghc/ghc][wip/strict-ttg] Strict TTG extension fields (#18764) Message-ID: <5f74480da6692_80b3f8468ed00041555486a@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/strict-ttg at Glasgow Haskell Compiler / GHC Commits: 4b91e136 by Vladislav Zavialov at 2020-09-30T11:54:28+03:00 Strict TTG extension fields (#18764) Before this patch, some of the TTG extension fields were non-strict: data HsType pass = ... | HsTyVar (XTyVar pass) PromotionFlag (LIdP pass) | HsAppTy (XAppTy pass) (LHsType pass) (LHsType pass) | ... Now they are strict: data HsType pass = ... | HsTyVar !(XTyVar pass) PromotionFlag (LIdP pass) | HsAppTy !(XAppTy pass) (LHsType pass) (LHsType pass) | ... This allows us to selectively exclude certain constructors from a particular pass. For example, if we wanted to statically guarantee that HsTyVar is never used in the GhcTc pass, we could encode it as follows: type instance XTyVar GhcTc = Void Then the pattern-match exhaustiveness checker could see that HsTyVar is an impossible case, even without an explicit call to `absurd`. 04b6cf947ea065a210a216cc91f918cc1660d430 applied this trick to TTG extension constructors, to avoid excessive use of `noExtCon`. This patch takes it a bit further and makes all extension fields throughout the compiler strict. - - - - - 8 changed files: - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs Changes: ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -79,7 +79,7 @@ type LHsLocalBinds id = XRec id (HsLocalBinds id) -- or a 'where' clause data HsLocalBindsLR idL idR = HsValBinds - (XHsValBinds idL idR) + !(XHsValBinds idL idR) (HsValBindsLR idL idR) -- ^ Haskell Value Bindings @@ -89,11 +89,11 @@ data HsLocalBindsLR idL idR -- renamer to report them | HsIPBinds - (XHsIPBinds idL idR) + !(XHsIPBinds idL idR) (HsIPBinds idR) -- ^ Haskell Implicit Parameter Bindings - | EmptyLocalBinds (XEmptyLocalBinds idL idR) + | EmptyLocalBinds !(XEmptyLocalBinds idL idR) -- ^ Empty Local Bindings | XHsLocalBindsLR @@ -121,7 +121,7 @@ data HsValBindsLR idL idR -- Not dependency analysed -- Recursive by default ValBinds - (XValBinds idL idR) + !(XValBinds idL idR) (LHsBindsLR idL idR) [LSig idR] -- | Value Bindings Out @@ -224,7 +224,7 @@ data HsBindLR idL idR -- For details on above see note [Api annotations] in GHC.Parser.Annotation FunBind { - fun_ext :: XFunBind idL idR, + fun_ext :: !(XFunBind idL idR), -- ^ After the renamer (but before the type-checker), this contains the -- locally-bound free variables of this defn. See Note [Bind free vars] @@ -264,7 +264,7 @@ data HsBindLR idL idR -- For details on above see note [Api annotations] in GHC.Parser.Annotation | PatBind { - pat_ext :: XPatBind idL idR, -- ^ See Note [Bind free vars] + pat_ext :: !(XPatBind idL idR), -- ^ See Note [Bind free vars] pat_lhs :: LPat idL, pat_rhs :: GRHSs idR (LHsExpr idR), pat_ticks :: ([Tickish Id], [[Tickish Id]]) @@ -277,14 +277,14 @@ data HsBindLR idL idR -- Dictionary binding and suchlike. -- All VarBinds are introduced by the type checker | VarBind { - var_ext :: XVarBind idL idR, + var_ext :: !(XVarBind idL idR), var_id :: IdP idL, var_rhs :: LHsExpr idR -- ^ Located only for consistency } -- | Abstraction Bindings | AbsBinds { -- Binds abstraction; TRANSLATION - abs_ext :: XAbsBinds idL idR, + abs_ext :: !(XAbsBinds idL idR), abs_tvs :: [TyVar], abs_ev_vars :: [EvVar], -- ^ Includes equality constraints @@ -306,7 +306,7 @@ data HsBindLR idL idR -- | Patterns Synonym Binding | PatSynBind - (XPatSynBind idL idR) + !(XPatSynBind idL idR) (PatSynBind idL idR) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnPattern', -- 'GHC.Parser.Annotation.AnnLarrow','GHC.Parser.Annotation.AnnEqual', @@ -345,7 +345,7 @@ type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon -- | Abstraction Bindings Export data ABExport p - = ABE { abe_ext :: XABE p + = ABE { abe_ext :: !(XABE p) , abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id , abe_mono :: IdP p , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper] @@ -367,7 +367,7 @@ type instance XXABExport (GhcPass p) = NoExtCon -- | Pattern Synonym binding data PatSynBind idL idR - = PSB { psb_ext :: XPSB idL idR, -- ^ Post renaming, FVs. + = PSB { psb_ext :: !(XPSB idL idR), -- ^ Post renaming, FVs. -- See Note [Bind free vars] psb_id :: LIdP idL, -- ^ Name of the pattern synonym psb_args :: HsPatSynDetails idR, -- ^ Formal parameter names @@ -798,7 +798,7 @@ pprTicks pp_no_debug pp_when_debug -- | Haskell Implicit Parameter Bindings data HsIPBinds id = IPBinds - (XIPBinds id) + !(XIPBinds id) [LIPBind id] -- TcEvBinds -- Only in typechecker output; binds -- -- uses of the implicit parameters @@ -837,7 +837,7 @@ type LIPBind id = XRec id (IPBind id) -- For details on above see note [Api annotations] in GHC.Parser.Annotation data IPBind id = IPBind - (XCIPBind id) + !(XCIPBind id) (Either (XRec id HsIPName) (IdP id)) (LHsExpr id) | XIPBind !(XXIPBind id) @@ -891,7 +891,7 @@ data Sig pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation TypeSig - (XTypeSig pass) + !(XTypeSig pass) [LIdP pass] -- LHS of the signature; e.g. f,g,h :: blah (LHsSigWcType pass) -- RHS of the signature; can have wildcards @@ -904,7 +904,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) [LIdP pass] (LHsSigType pass) + | PatSynSig !(XPatSynSig pass) [LIdP pass] (LHsSigType pass) -- P :: forall a b. Req => Prov => ty -- | A signature for a class method @@ -917,14 +917,14 @@ data Sig pass -- -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault', -- 'GHC.Parser.Annotation.AnnDcolon' - | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass) + | ClassOpSig !(XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass) -- | A type signature in generated code, notably the code -- generated for record selectors. We simply record -- the desired Id itself, replete with its name, type -- and IdDetails. Otherwise it's just like a type -- signature: there should be an accompanying binding - | IdSig (XIdSig pass) Id + | IdSig !(XIdSig pass) Id -- | An ordinary fixity declaration -- @@ -935,7 +935,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnVal' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | FixSig (XFixSig pass) (FixitySig pass) + | FixSig !(XFixSig pass) (FixitySig pass) -- | An inline pragma -- @@ -948,7 +948,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnClose' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | InlineSig (XInlineSig pass) + | InlineSig !(XInlineSig pass) (LIdP pass) -- Function name InlinePragma -- Never defaultInlinePragma @@ -964,7 +964,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnDcolon' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | SpecSig (XSpecSig pass) + | SpecSig !(XSpecSig pass) (LIdP pass) -- Specialise a function or datatype ... [LHsSigType pass] -- ... to these types InlinePragma -- The pragma on SPECIALISE_INLINE form. @@ -982,7 +982,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnInstance','GHC.Parser.Annotation.AnnClose' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass) + | SpecInstSig !(XSpecInstSig pass) SourceText (LHsSigType pass) -- Note [Pragma source text] in GHC.Types.Basic -- | A minimal complete definition pragma @@ -994,7 +994,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnClose' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | MinimalSig (XMinimalSig pass) + | MinimalSig !(XMinimalSig pass) SourceText (LBooleanFormula (LIdP pass)) -- Note [Pragma source text] in GHC.Types.Basic @@ -1006,7 +1006,7 @@ data Sig pass -- -- > {-# SCC funName "cost_centre_name" #-} - | SCCFunSig (XSCCFunSig pass) + | SCCFunSig !(XSCCFunSig pass) SourceText -- Note [Pragma source text] in GHC.Types.Basic (LIdP pass) -- Function name (Maybe (XRec pass StringLiteral)) @@ -1017,7 +1017,7 @@ data Sig pass -- Used to inform the pattern match checker about additional -- complete matchings which, for example, arise from pattern -- synonym definitions. - | CompleteMatchSig (XCompleteMatchSig pass) + | CompleteMatchSig !(XCompleteMatchSig pass) SourceText (XRec pass [LIdP pass]) (Maybe (LIdP pass)) @@ -1040,7 +1040,7 @@ type instance XXSig (GhcPass p) = NoExtCon type LFixitySig pass = XRec pass (FixitySig pass) -- | Fixity Signature -data FixitySig pass = FixitySig (XFixitySig pass) [LIdP pass] Fixity +data FixitySig pass = FixitySig !(XFixitySig pass) [LIdP pass] Fixity | XFixitySig !(XXFixitySig pass) type instance XFixitySig (GhcPass p) = NoExtField ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -144,21 +144,21 @@ type LHsDecl p = XRec p (HsDecl p) -- | A Haskell Declaration data HsDecl p - = TyClD (XTyClD p) (TyClDecl p) -- ^ Type or Class Declaration - | InstD (XInstD p) (InstDecl p) -- ^ Instance declaration - | DerivD (XDerivD p) (DerivDecl p) -- ^ Deriving declaration - | ValD (XValD p) (HsBind p) -- ^ Value declaration - | SigD (XSigD p) (Sig p) -- ^ Signature declaration - | KindSigD (XKindSigD p) (StandaloneKindSig p) -- ^ Standalone kind signature - | DefD (XDefD p) (DefaultDecl p) -- ^ 'default' declaration - | ForD (XForD p) (ForeignDecl p) -- ^ Foreign declaration - | WarningD (XWarningD p) (WarnDecls p) -- ^ Warning declaration - | AnnD (XAnnD p) (AnnDecl p) -- ^ Annotation declaration - | RuleD (XRuleD p) (RuleDecls p) -- ^ Rule declaration - | SpliceD (XSpliceD p) (SpliceDecl p) -- ^ Splice declaration - -- (Includes quasi-quotes) - | DocD (XDocD p) (DocDecl) -- ^ Documentation comment declaration - | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration + = TyClD !(XTyClD p) (TyClDecl p) -- ^ Type or Class Declaration + | InstD !(XInstD p) (InstDecl p) -- ^ Instance declaration + | DerivD !(XDerivD p) (DerivDecl p) -- ^ Deriving declaration + | ValD !(XValD p) (HsBind p) -- ^ Value declaration + | SigD !(XSigD p) (Sig p) -- ^ Signature declaration + | KindSigD !(XKindSigD p) (StandaloneKindSig p) -- ^ Standalone kind signature + | DefD !(XDefD p) (DefaultDecl p) -- ^ 'default' declaration + | ForD !(XForD p) (ForeignDecl p) -- ^ Foreign declaration + | WarningD !(XWarningD p) (WarnDecls p) -- ^ Warning declaration + | AnnD !(XAnnD p) (AnnDecl p) -- ^ Annotation declaration + | RuleD !(XRuleD p) (RuleDecls p) -- ^ Rule declaration + | SpliceD !(XSpliceD p) (SpliceDecl p) -- ^ Splice declaration + -- !(Includes quasi-quotes) + | DocD !(XDocD p) (DocDecl) -- ^ Documentation comment declaration + | RoleAnnotD !(XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration | XHsDecl !(XXHsDecl p) type instance XTyClD (GhcPass _) = NoExtField @@ -259,7 +259,7 @@ partitionBindsAndSigs = go -- fed to the renamer. data HsGroup p = HsGroup { - hs_ext :: XCHsGroup p, + hs_ext :: !(XCHsGroup p), hs_valds :: HsValBinds p, hs_splcds :: [LSpliceDecl p], @@ -417,7 +417,7 @@ type LSpliceDecl pass = XRec pass (SpliceDecl pass) -- | Splice Declaration data SpliceDecl p = SpliceDecl -- Top level splice - (XSpliceDecl p) + !(XSpliceDecl p) (XRec p (HsSplice p)) SpliceExplicitFlag | XSpliceDecl !(XXSpliceDecl p) @@ -584,7 +584,7 @@ data TyClDecl pass -- 'GHC.Parser.Annotation.AnnVbar' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass } + FamDecl { tcdFExt :: !(XFamDecl pass), tcdFam :: FamilyDecl pass } | -- | @type@ declaration -- @@ -592,7 +592,7 @@ data TyClDecl pass -- 'GHC.Parser.Annotation.AnnEqual', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - SynDecl { tcdSExt :: XSynDecl pass -- ^ Post renameer, FVs + SynDecl { tcdSExt :: !(XSynDecl pass) -- ^ Post renameer, FVs , tcdLName :: LIdP pass -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an -- associated type these @@ -609,14 +609,14 @@ data TyClDecl pass -- 'GHC.Parser.Annotation.AnnWhere', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs - , tcdLName :: LIdP pass -- ^ Type constructor + DataDecl { tcdDExt :: !(XDataDecl pass) -- ^ Post renamer, CUSK flag, FVs + , tcdLName :: LIdP pass -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables -- See Note [TyVar binders for associated declarations] , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration , tcdDataDefn :: HsDataDefn pass } - | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs + | ClassDecl { tcdCExt :: !(XClassDecl pass), -- ^ Post renamer, FVs tcdCtxt :: LHsContext pass, -- ^ Context... tcdLName :: LIdP pass, -- ^ Name of the class tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables @@ -1004,7 +1004,7 @@ in GHC.Rename.Module for more info. -- | Type or Class Group data TyClGroup pass -- See Note [TyClGroups and dependency analysis] - = TyClGroup { group_ext :: XCTyClGroup pass + = TyClGroup { group_ext :: !(XCTyClGroup pass) , group_tyclds :: [LTyClDecl pass] , group_roles :: [LRoleAnnotDecl pass] , group_kisigs :: [LStandaloneKindSig pass] @@ -1102,19 +1102,19 @@ type LFamilyResultSig pass = XRec pass (FamilyResultSig pass) -- | type Family Result Signature data FamilyResultSig pass = -- see Note [FamilyResultSig] - NoSig (XNoSig pass) + NoSig !(XNoSig pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | KindSig (XCKindSig pass) (LHsKind pass) + | KindSig !(XCKindSig pass) (LHsKind pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : -- 'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon', -- 'GHC.Parser.Annotation.AnnCloseP' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | TyVarSig (XTyVarSig pass) (LHsTyVarBndr () pass) + | TyVarSig !(XTyVarSig pass) (LHsTyVarBndr () pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : -- 'GHC.Parser.Annotation.AnnOpenP','GHC.Parser.Annotation.AnnDcolon', -- 'GHC.Parser.Annotation.AnnCloseP', 'GHC.Parser.Annotation.AnnEqual' @@ -1134,7 +1134,7 @@ type LFamilyDecl pass = XRec pass (FamilyDecl pass) -- | type Family Declaration data FamilyDecl pass = FamilyDecl - { fdExt :: XCFamilyDecl pass + { fdExt :: !(XCFamilyDecl pass) , fdInfo :: FamilyInfo pass -- type/data, closed/open , fdLName :: LIdP pass -- type constructor , fdTyVars :: LHsQTyVars pass -- type variables @@ -1267,7 +1267,7 @@ data HsDataDefn pass -- The payload of a data type defn -- data/newtype T a = -- data/newtype instance T [a] = -- @ - HsDataDefn { dd_ext :: XCHsDataDefn pass, + HsDataDefn { dd_ext :: !(XCHsDataDefn pass), dd_ND :: NewOrData, dd_ctxt :: LHsContext pass, -- ^ Context dd_cType :: Maybe (XRec pass CType), @@ -1318,7 +1318,7 @@ type LHsDerivingClause pass = XRec pass (HsDerivingClause pass) data HsDerivingClause pass -- See Note [Deriving strategies] in GHC.Tc.Deriv = HsDerivingClause - { deriv_clause_ext :: XCHsDerivingClause pass + { deriv_clause_ext :: !(XCHsDerivingClause pass) , deriv_clause_strategy :: Maybe (LDerivStrategy pass) -- ^ The user-specified strategy (if any) to use when deriving -- 'deriv_clause_tys'. @@ -1365,13 +1365,13 @@ data DerivClauseTys pass -- be a type constructor without any arguments. -- -- Example: @deriving Eq@ - DctSingle (XDctSingle pass) (LHsSigType pass) + DctSingle !(XDctSingle pass) (LHsSigType pass) -- | A @deriving@ clause with a comma-separated list of types, surrounded -- by enclosing parentheses. -- -- Example: @deriving (Eq, C a)@ - | DctMulti (XDctMulti pass) [LHsSigType pass] + | DctMulti !(XDctMulti pass) [LHsSigType pass] | XDerivClauseTys !(XXDerivClauseTys pass) @@ -1387,7 +1387,7 @@ instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) data StandaloneKindSig pass - = StandaloneKindSig (XStandaloneKindSig pass) + = StandaloneKindSig !(XStandaloneKindSig pass) (LIdP pass) -- Why a single binder? See #16754 (LHsSigType pass) -- Why not LHsSigWcType? See Note [Wildcards in standalone kind signatures] | XStandaloneKindSig !(XXStandaloneKindSig pass) @@ -1458,7 +1458,7 @@ type LConDecl pass = XRec pass (ConDecl pass) -- | data Constructor Declaration data ConDecl pass = ConDeclGADT - { con_g_ext :: XConDeclGADT pass + { con_g_ext :: !(XConDeclGADT pass) , con_names :: [LIdP pass] -- The following fields describe the type after the '::' @@ -1481,7 +1481,7 @@ data ConDecl pass } | ConDeclH98 - { con_ext :: XConDeclH98 pass + { con_ext :: !(XConDeclH98 pass) , con_name :: LIdP pass , con_forall :: XRec pass Bool @@ -1872,7 +1872,7 @@ type FamInstEqn pass rhs = HsImplicitBndrs pass (FamEqn pass rhs) -- See Note [Family instance declaration binders] data FamEqn pass rhs = FamEqn - { feqn_ext :: XCFamEqn pass rhs + { feqn_ext :: !(XCFamEqn pass rhs) , feqn_tycon :: LIdP pass , feqn_bndrs :: Maybe [LHsTyVarBndr () pass] -- ^ Optional quantified type vars , feqn_pats :: HsTyPats pass @@ -1896,7 +1896,7 @@ type LClsInstDecl pass = XRec pass (ClsInstDecl pass) -- | Class Instance Declaration data ClsInstDecl pass = ClsInstDecl - { cid_ext :: XCClsInstDecl pass + { cid_ext :: !(XCClsInstDecl pass) , 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. @@ -1929,13 +1929,13 @@ type LInstDecl pass = XRec pass (InstDecl pass) -- | Instance Declaration data InstDecl pass -- Both class and family instances = ClsInstD - { cid_d_ext :: XClsInstD pass + { cid_d_ext :: !(XClsInstD pass) , cid_inst :: ClsInstDecl pass } | DataFamInstD -- data family instance - { dfid_ext :: XDataFamInstD pass + { dfid_ext :: !(XDataFamInstD pass) , dfid_inst :: DataFamInstDecl pass } | TyFamInstD -- type family instance - { tfid_ext :: XTyFamInstD pass + { tfid_ext :: !(XTyFamInstD pass) , tfid_inst :: TyFamInstDecl pass } | XInstDecl !(XXInstDecl pass) @@ -2085,7 +2085,7 @@ type LDerivDecl pass = XRec pass (DerivDecl pass) -- | Stand-alone 'deriving instance' declaration data DerivDecl pass = DerivDecl - { deriv_ext :: XCDerivDecl pass + { deriv_ext :: !(XCDerivDecl pass) , deriv_type :: LHsSigWcType pass -- ^ The instance type to derive. -- @@ -2144,7 +2144,7 @@ data DerivStrategy pass -- etc.) | AnyclassStrategy -- ^ @-XDeriveAnyClass@ | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@ - | ViaStrategy (XViaStrategy pass) + | ViaStrategy !(XViaStrategy pass) -- ^ @-XDerivingVia@ type instance XViaStrategy GhcPs = LHsSigType GhcPs @@ -2202,7 +2202,7 @@ type LDefaultDecl pass = XRec pass (DefaultDecl pass) -- | Default Declaration data DefaultDecl pass - = DefaultDecl (XCDefaultDecl pass) [LHsType pass] + = DefaultDecl !(XCDefaultDecl pass) [LHsType pass] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnDefault', -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose' @@ -2237,13 +2237,13 @@ type LForeignDecl pass = XRec pass (ForeignDecl pass) -- | Foreign Declaration data ForeignDecl pass = ForeignImport - { fd_i_ext :: XForeignImport pass -- Post typechecker, rep_ty ~ sig_ty + { fd_i_ext :: !(XForeignImport pass) -- Post typechecker, rep_ty ~ sig_ty , fd_name :: LIdP pass -- defines this name , fd_sig_ty :: LHsSigType pass -- sig_ty , fd_fi :: ForeignImport } | ForeignExport - { fd_e_ext :: XForeignExport pass -- Post typechecker, rep_ty ~ sig_ty + { fd_e_ext :: !(XForeignExport pass) -- Post typechecker, rep_ty ~ sig_ty , fd_name :: LIdP pass -- uses this name , fd_sig_ty :: LHsSigType pass -- sig_ty , fd_fe :: ForeignExport } @@ -2373,7 +2373,7 @@ type LRuleDecls pass = XRec pass (RuleDecls pass) -- Note [Pragma source text] in GHC.Types.Basic -- | Rule Declarations -data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass +data RuleDecls pass = HsRules { rds_ext :: !(XCRuleDecls pass) , rds_src :: SourceText , rds_rules :: [LRuleDecl pass] } | XRuleDecls !(XXRuleDecls pass) @@ -2387,7 +2387,7 @@ type LRuleDecl pass = XRec pass (RuleDecl pass) -- | Rule Declaration data RuleDecl pass = HsRule -- Source rule - { rd_ext :: XHsRule pass + { rd_ext :: !(XHsRule pass) -- ^ After renamer, free-vars from the LHS and RHS , rd_name :: XRec pass (SourceText,RuleName) -- ^ Note [Pragma source text] in "GHC.Types.Basic" @@ -2426,8 +2426,8 @@ type LRuleBndr pass = XRec pass (RuleBndr pass) -- | Rule Binder data RuleBndr pass - = RuleBndr (XCRuleBndr pass) (LIdP pass) - | RuleBndrSig (XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass) + = RuleBndr !(XCRuleBndr pass) (LIdP pass) + | RuleBndrSig !(XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass) | XRuleBndr !(XXRuleBndr pass) -- ^ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', @@ -2516,7 +2516,7 @@ type LWarnDecls pass = XRec pass (WarnDecls pass) -- Note [Pragma source text] in GHC.Types.Basic -- | Warning pragma Declarations -data WarnDecls pass = Warnings { wd_ext :: XWarnings pass +data WarnDecls pass = Warnings { wd_ext :: !(XWarnings pass) , wd_src :: SourceText , wd_warnings :: [LWarnDecl pass] } @@ -2529,7 +2529,7 @@ type instance XXWarnDecls (GhcPass _) = NoExtCon type LWarnDecl pass = XRec pass (WarnDecl pass) -- | Warning pragma Declaration -data WarnDecl pass = Warning (XWarning pass) [LIdP pass] WarningTxt +data WarnDecl pass = Warning !(XWarning pass) [LIdP pass] WarningTxt | XWarnDecl !(XXWarnDecl pass) type instance XWarning (GhcPass _) = NoExtField @@ -2561,7 +2561,7 @@ type LAnnDecl pass = XRec pass (AnnDecl pass) -- | Annotation Declaration data AnnDecl pass = HsAnnotation - (XHsAnnotation pass) + !(XHsAnnotation pass) SourceText -- Note [Pragma source text] in GHC.Types.Basic (AnnProvenance (IdP pass)) (XRec pass (HsExpr pass)) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', @@ -2615,7 +2615,7 @@ type LRoleAnnotDecl pass = XRec pass (RoleAnnotDecl pass) -- top-level declarations -- | Role Annotation Declaration data RoleAnnotDecl pass - = RoleAnnotDecl (XCRoleAnnotDecl pass) + = RoleAnnotDecl !(XCRoleAnnotDecl pass) (LIdP pass) -- type constructor [XRec pass (Maybe Role)] -- optional annotations -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType', ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -242,11 +242,11 @@ is Less Cool because -- | A Haskell expression. data HsExpr p - = HsVar (XVar p) + = HsVar !(XVar p) (LIdP p) -- ^ Variable -- See Note [Located RdrNames] - | HsUnboundVar (XUnboundVar p) + | HsUnboundVar !(XUnboundVar p) OccName -- ^ Unbound variable; also used for "holes" -- (_ or _x). -- Turned from HsVar to HsUnboundVar by the @@ -255,32 +255,32 @@ data HsExpr p -- The (XUnboundVar p) field becomes Id -- after typechecking - | HsConLikeOut (XConLikeOut p) + | HsConLikeOut !(XConLikeOut p) ConLike -- ^ After typechecker only; must be different -- HsVar for pretty printing - | HsRecFld (XRecFld p) + | HsRecFld !(XRecFld p) (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector -- The parser produces HsVars -- The renamer renames record-field selectors to HsRecFld -- The typechecker preserves HsRecFld - | HsOverLabel (XOverLabel p) + | HsOverLabel !(XOverLabel p) (Maybe (IdP p)) FastString -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels) -- @Just id@ means @RebindableSyntax@ is in use, and gives the id of the -- in-scope 'fromLabel'. -- NB: Not in use after typechecking - | HsIPVar (XIPVar p) + | HsIPVar !(XIPVar p) HsIPName -- ^ Implicit parameter (not in use after typechecking) - | HsOverLit (XOverLitE p) + | HsOverLit !(XOverLitE p) (HsOverLit p) -- ^ Overloaded literals - | HsLit (XLitE p) + | HsLit !(XLitE p) (HsLit p) -- ^ Simple (non-overloaded) literals - | HsLam (XLam p) + | HsLam !(XLam p) (MatchGroup p (LHsExpr p)) -- ^ Lambda abstraction. Currently always a single match -- @@ -289,7 +289,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case + | HsLamCase !(XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case -- -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen', @@ -297,9 +297,9 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsApp (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application + | HsApp !(XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application - | HsAppType (XAppTypeE p) -- After typechecking: the type argument + | HsAppType !(XAppTypeE p) -- After typechecking: the type argument (LHsExpr p) (LHsWcType (NoGhcTc p)) -- ^ Visible type application -- @@ -314,7 +314,7 @@ data HsExpr p -- NB We need an expr for the operator in an OpApp/Section since -- the typechecker may need to apply the operator to a few types. - | OpApp (XOpApp p) + | OpApp !(XOpApp p) (LHsExpr p) -- left operand (LHsExpr p) -- operator (LHsExpr p) -- right operand @@ -325,7 +325,7 @@ data HsExpr p -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | NegApp (XNegApp p) + | NegApp !(XNegApp p) (LHsExpr p) (SyntaxExpr p) @@ -333,13 +333,13 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsPar (XPar p) + | HsPar !(XPar p) (LHsExpr p) -- ^ Parenthesised expr; see Note [Parens in HsSyn] - | SectionL (XSectionL p) + | SectionL !(XSectionL p) (LHsExpr p) -- operand; see Note [Sections in HsSyn] (LHsExpr p) -- operator - | SectionR (XSectionR p) + | SectionR !(XSectionR p) (LHsExpr p) -- operator; see Note [Sections in HsSyn] (LHsExpr p) -- operand @@ -351,7 +351,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- Note [ExplicitTuple] | ExplicitTuple - (XExplicitTuple p) + !(XExplicitTuple p) [LHsTupArg p] Boxity @@ -363,7 +363,7 @@ data HsExpr p -- There will be multiple 'GHC.Parser.Annotation.AnnVbar', (1 - alternative) before -- the expression, (arity - alternative) after it | ExplicitSum - (XExplicitSum p) + !(XExplicitSum p) ConTag -- Alternative (one-based) Arity -- Sum arity (LHsExpr p) @@ -373,7 +373,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' @'}'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCase (XCase p) + | HsCase !(XCase p) (LHsExpr p) (MatchGroup p (LHsExpr p)) @@ -383,7 +383,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnElse', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsIf (XIf p) -- GhcPs: this is a Bool; False <=> do not use + | HsIf !(XIf p) -- GhcPs: this is a Bool; False <=> do not use -- rebindable syntax (LHsExpr p) -- predicate (LHsExpr p) -- then part @@ -395,7 +395,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnClose', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)] + | HsMultiIf !(XMultiIf p) [LGRHS p (LHsExpr p)] -- | let(rec) -- @@ -404,7 +404,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' @'}'@,'GHC.Parser.Annotation.AnnIn' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsLet (XLet p) + | HsLet !(XLet p) (LHsLocalBinds p) (LHsExpr p) @@ -414,7 +414,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsDo (XDo p) -- Type of the whole expression + | HsDo !(XDo p) -- Type of the whole expression (HsStmtContext GhcRn) -- The parameterisation is unimportant -- because in this context we never use -- the PatGuard or ParStmt variant @@ -428,7 +428,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Empty lists] | ExplicitList - (XExplicitList p) -- Gives type of components of list + !(XExplicitList p) -- Gives type of components of list (Maybe (SyntaxExpr p)) -- For OverloadedLists, the fromListN witness [LHsExpr p] @@ -440,7 +440,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecordCon - { rcon_ext :: XRecordCon p + { rcon_ext :: !(XRecordCon p) , rcon_con_name :: LIdP p -- The constructor name; -- not used after type checking , rcon_flds :: HsRecordBinds p } -- The fields @@ -452,7 +452,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecordUpd - { rupd_ext :: XRecordUpd p + { rupd_ext :: !(XRecordUpd p) , rupd_expr :: LHsExpr p , rupd_flds :: [LHsRecUpdField p] } @@ -465,7 +465,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ExprWithTySig - (XExprWithTySig p) + !(XExprWithTySig p) (LHsExpr p) (LHsSigWcType (NoGhcTc p)) @@ -478,7 +478,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | ArithSeq - (XArithSeq p) + !(XArithSeq p) (Maybe (SyntaxExpr p)) -- For OverloadedLists, the fromList witness (ArithSeqInfo p) @@ -493,17 +493,17 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose','GHC.Parser.Annotation.AnnCloseQ' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsBracket (XBracket p) (HsBracket p) + | HsBracket !(XBracket p) (HsBracket p) -- See Note [Pending Splices] | HsRnBracketOut - (XRnBracketOut p) + !(XRnBracketOut p) (HsBracket GhcRn) -- Output of the renamer is the *original* renamed -- expression, plus [PendingRnSplice] -- _renamed_ splices to be type checked | HsTcBracketOut - (XTcBracketOut p) + !(XTcBracketOut p) (Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument -- to the quote. (HsBracket GhcRn) -- Output of the type checker is the *original* @@ -515,7 +515,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsSpliceE (XSpliceE p) (HsSplice p) + | HsSpliceE !(XSpliceE p) (HsSplice p) ----------------------------------------------------------- -- Arrow notation extension @@ -526,7 +526,7 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnRarrow' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsProc (XProc p) + | HsProc !(XProc p) (LPat p) -- arrow abstraction, proc (LHsCmdTop p) -- body of the abstraction -- always has an empty stack @@ -536,26 +536,26 @@ data HsExpr p -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnStatic', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsStatic (XStatic p) -- Free variables of the body + | HsStatic !(XStatic p) -- Free variables of the body (LHsExpr p) -- Body --------------------------------------- -- Haskell program coverage (Hpc) Support | HsTick - (XTick p) + !(XTick p) (Tickish (IdP p)) (LHsExpr p) -- sub-expression | HsBinTick - (XBinTick p) + !(XBinTick p) Int -- module-local tick number for True Int -- module-local tick number for False (LHsExpr p) -- sub-expression --------------------------------------- -- Expressions annotated with pragmas, written as {-# ... #-} - | HsPragE (XPragE p) (HsPragE p) (LHsExpr p) + | HsPragE !(XPragE p) (HsPragE p) (LHsExpr p) | XExpr !(XXExpr p) -- Note [Trees that Grow] extension constructor for the @@ -831,7 +831,7 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where -- | A pragma, written as {-# ... #-}, that may appear within an expression. data HsPragE p - = HsPragSCC (XSCC p) + = HsPragSCC !(XSCC p) SourceText -- Note [Pragma source text] in GHC.Types.Basic StringLiteral -- "set cost centre" SCC pragma @@ -847,7 +847,6 @@ data HsPragE p | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField -type instance XCoreAnn (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -863,8 +862,8 @@ type LHsTupArg id = XRec id (HsTupArg id) -- | Haskell Tuple Argument data HsTupArg id - = Present (XPresent id) (LHsExpr id) -- ^ The argument - | Missing (XMissing id) -- ^ The argument is missing, but this is its type + = Present !(XPresent id) (LHsExpr id) -- ^ The argument + | Missing !(XMissing id) -- ^ The argument is missing, but this is its type | XTupArg !(XXTupArg id) -- ^ Note [Trees that Grow] extension point type instance XPresent (GhcPass _) = NoExtField @@ -1419,9 +1418,9 @@ data HsCmd id -- 'GHC.Parser.Annotation.AnnRarrowtail' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg) - (XCmdArrApp id) -- type of the arrow expressions f, - -- of the form a t t', where arg :: t + = HsCmdArrApp -- Arrow tail, or arrow application (f -< arg) + !(XCmdArrApp id) -- type of the arrow expressions f, + -- of the form a t t', where arg :: t (LHsExpr id) -- arrow expression, f (LHsExpr id) -- input expression, arg HsArrAppType -- higher-order (-<<) or first-order (-<) @@ -1433,7 +1432,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsCmdArrForm -- Command formation, (| e cmd1 .. cmdn |) - (XCmdArrForm id) + !(XCmdArrForm id) (LHsExpr id) -- The operator. -- After type-checking, a type abstraction to be -- applied to the type of the local environment tuple @@ -1443,25 +1442,25 @@ data HsCmd id -- were converted from OpApp's by the renamer [LHsCmdTop id] -- argument commands - | HsCmdApp (XCmdApp id) + | HsCmdApp !(XCmdApp id) (LHsCmd id) (LHsExpr id) - | HsCmdLam (XCmdLam id) + | HsCmdLam !(XCmdLam id) (MatchGroup id (LHsCmd id)) -- kappa -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', -- 'GHC.Parser.Annotation.AnnRarrow', -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdPar (XCmdPar id) + | HsCmdPar !(XCmdPar id) (LHsCmd id) -- parenthesised command -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdCase (XCmdCase id) + | HsCmdCase !(XCmdCase id) (LHsExpr id) (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnCase', @@ -1470,7 +1469,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdLamCase (XCmdLamCase id) + | HsCmdLamCase !(XCmdLamCase id) (MatchGroup id (LHsCmd id)) -- bodies are HsCmd's -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLam', -- 'GHC.Parser.Annotation.AnnCase','GHC.Parser.Annotation.AnnOpen' @'{'@, @@ -1478,7 +1477,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdIf (XCmdIf id) + | HsCmdIf !(XCmdIf id) (SyntaxExpr id) -- cond function (LHsExpr id) -- predicate (LHsCmd id) -- then part @@ -1490,7 +1489,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdLet (XCmdLet id) + | HsCmdLet !(XCmdLet id) (LHsLocalBinds id) -- let(rec) (LHsCmd id) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet', @@ -1499,7 +1498,7 @@ data HsCmd id -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsCmdDo (XCmdDo id) -- Type of the whole expression + | HsCmdDo !(XCmdDo id) -- Type of the whole expression (XRec id [CmdLStmt id]) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo', -- 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnSemi', @@ -1551,7 +1550,7 @@ type LHsCmdTop p = XRec p (HsCmdTop p) -- | Haskell Top-level Command data HsCmdTop p - = HsCmdTop (XCmdTop p) + = HsCmdTop !(XCmdTop p) (LHsCmd p) | XCmdTop !(XXCmdTop p) -- Note [Trees that Grow] extension point @@ -1702,7 +1701,7 @@ patterns in each equation. -} data MatchGroup p body - = MG { mg_ext :: XMG p body -- Post-typechecker, types of args and result + = MG { mg_ext :: !(XMG p body) -- Post-typechecker, types of args and result , mg_alts :: XRec p [LMatch p body] -- The alternatives , mg_origin :: Origin } -- The type is the type of the entire group @@ -1730,7 +1729,7 @@ type LMatch id body = XRec id (Match id body) -- For details on above see note [Api annotations] in GHC.Parser.Annotation data Match p body = Match { - m_ext :: XCMatch p body, + m_ext :: !(XCMatch p body), m_ctxt :: HsMatchContext (NoGhcTc p), -- See note [m_ctxt in Match] m_pats :: [LPat p], -- The patterns @@ -1821,7 +1820,7 @@ hsLMatchPats (L _ (Match { m_pats = pats })) = pats -- For details on above see note [Api annotations] in GHC.Parser.Annotation data GRHSs p body = GRHSs { - grhssExt :: XCGRHSs p body, + grhssExt :: !(XCGRHSs p body), grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs grhssLocalBinds :: LHsLocalBinds p -- ^ The where clause } @@ -1834,7 +1833,7 @@ type instance XXGRHSs (GhcPass _) b = NoExtCon type LGRHS id body = XRec id (GRHS id body) -- | Guarded Right Hand Side. -data GRHS p body = GRHS (XCGRHS p body) +data GRHS p body = GRHS !(XCGRHS p body) [GuardLStmt p] -- Guards body -- Right hand side | XGRHS !(XXGRHS p body) @@ -1973,7 +1972,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) = LastStmt -- Always the last Stmt in ListComp, MonadComp, -- and (after the renamer, see GHC.Rename.Expr.checkLastStmt) DoExpr, MDoExpr -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff - (XLastStmt idL idR body) + !(XLastStmt idL idR body) body (Maybe Bool) -- Whether return was stripped -- Just True <=> return with a dollar was stripped by ApplicativeDo @@ -1987,7 +1986,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLarrow' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | BindStmt (XBindStmt idL idR body) + | BindStmt !(XBindStmt idL idR body) -- ^ Post renaming has optional fail and bind / (>>=) operator. -- Post typechecking, also has multiplicity of the argument -- and the result type of the function passed to bind; @@ -2004,14 +2003,14 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- For full details, see Note [ApplicativeDo] in "GHC.Rename.Expr" -- | ApplicativeStmt - (XApplicativeStmt idL idR body) -- Post typecheck, Type of the body + !(XApplicativeStmt idL idR body) -- Post typecheck, Type of the body [ ( SyntaxExpr idR , ApplicativeArg idL) ] -- [(<$>, e1), (<*>, e2), ..., (<*>, en)] (Maybe (SyntaxExpr idR)) -- 'join', if necessary - | BodyStmt (XBodyStmt idL idR body) -- Post typecheck, element type - -- of the RHS (used for arrows) + | BodyStmt !(XBodyStmt idL idR body) -- Post typecheck, element type + -- of the RHS (used for arrows) body -- See Note [BodyStmt] (SyntaxExpr idR) -- The (>>) operator (SyntaxExpr idR) -- The `guard` operator; used only in MonadComp @@ -2021,11 +2020,11 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- 'GHC.Parser.Annotation.AnnOpen' @'{'@,'GHC.Parser.Annotation.AnnClose' @'}'@, -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | LetStmt (XLetStmt idL idR body) (LHsLocalBindsLR idL idR) + | LetStmt !(XLetStmt idL idR body) (LHsLocalBindsLR idL idR) -- ParStmts only occur in a list/monad comprehension - | ParStmt (XParStmt idL idR body) -- Post typecheck, - -- S in (>>=) :: Q -> (R -> S) -> T + | ParStmt !(XParStmt idL idR body) -- Post typecheck, + -- S in (>>=) :: Q -> (R -> S) -> T [ParStmtBlock idL idR] (HsExpr idR) -- Polymorphic `mzip` for monad comprehensions (SyntaxExpr idR) -- The `>>=` operator @@ -2034,8 +2033,8 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- bound by the stmts and used after themp | TransStmt { - trS_ext :: XTransStmt idL idR body, -- Post typecheck, - -- R in (>>=) :: Q -> (R -> S) -> T + trS_ext :: !(XTransStmt idL idR body), -- Post typecheck, + -- R in (>>=) :: Q -> (R -> S) -> T trS_form :: TransForm, trS_stmts :: [ExprLStmt idL], -- Stmts to the *left* of the 'group' -- which generates the tuples to be grouped @@ -2060,7 +2059,7 @@ data StmtLR idL idR body -- body should always be (LHs**** idR) -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecStmt - { recS_ext :: XRecStmt idL idR body + { recS_ext :: !(XRecStmt idL idR body) , recS_stmts :: [LStmtLR idL idR body] -- The next two fields are only valid after renaming @@ -2154,7 +2153,7 @@ data TransForm -- The 'f' below is the 'using' function, 'e' is the by functio -- | Parenthesised Statement Block data ParStmtBlock idL idR = ParStmtBlock - (XParStmtBlock idL idR) + !(XParStmtBlock idL idR) [ExprLStmt idL] [IdP idR] -- The variables to be returned (SyntaxExpr idR) -- The return operator @@ -2182,7 +2181,7 @@ type FailOperator id = Maybe (SyntaxExpr id) -- | Applicative Argument data ApplicativeArg idL = ApplicativeArgOne -- A single statement (BindStmt or BodyStmt) - { xarg_app_arg_one :: XApplicativeArgOne idL + { xarg_app_arg_one :: !(XApplicativeArgOne idL) -- ^ The fail operator, after renaming -- -- The fail operator is needed if this is a BindStmt @@ -2201,7 +2200,7 @@ data ApplicativeArg idL -- See Note [Applicative BodyStmt] } | ApplicativeArgMany -- do { stmts; return vars } - { xarg_app_arg_many :: XApplicativeArgMany idL + { xarg_app_arg_many :: !(XApplicativeArgMany idL) , app_stmts :: [ExprLStmt idL] -- stmts , final_expr :: HsExpr idL -- return (v1,..,vn), or just (v1,..,vn) , bv_pattern :: LPat idL -- (v1,...,vn) @@ -2549,19 +2548,19 @@ pprQuals quals = interpp'SP quals -- | Haskell Splice data HsSplice id = HsTypedSplice -- $$z or $$(f 4) - (XTypedSplice id) + !(XTypedSplice id) SpliceDecoration -- Whether $$( ) variant found, for pretty printing (IdP id) -- A unique name to identify this splice point (LHsExpr id) -- See Note [Pending Splices] | HsUntypedSplice -- $z or $(f 4) - (XUntypedSplice id) + !(XUntypedSplice id) SpliceDecoration -- Whether $( ) variant found, for pretty printing (IdP id) -- A unique name to identify this splice point (LHsExpr id) -- See Note [Pending Splices] | HsQuasiQuote -- See Note [Quasi-quote overview] in GHC.Tc.Gen.Splice - (XQuasiQuote id) + !(XQuasiQuote id) (IdP id) -- Splice point (IdP id) -- Quoter SrcSpan -- The span of the enclosed string @@ -2573,7 +2572,7 @@ data HsSplice id -- This is the result of splicing a splice. It is produced by -- the renamer and consumed by the typechecker. It lives only -- between the two. - (XSpliced id) + !(XSpliced id) ThModFinalizers -- TH finalizers produced by the splice. (HsSplicedThing id) -- The result of splicing | XSplice !(XXSplice id) -- Note [Trees that Grow] extension point @@ -2779,14 +2778,14 @@ ppr_splice herald n e trail -- | Haskell Bracket data HsBracket p - = ExpBr (XExpBr p) (LHsExpr p) -- [| expr |] - | PatBr (XPatBr p) (LPat p) -- [p| pat |] - | DecBrL (XDecBrL p) [LHsDecl p] -- [d| decls |]; result of parser - | DecBrG (XDecBrG p) (HsGroup p) -- [d| decls |]; result of renamer - | TypBr (XTypBr p) (LHsType p) -- [t| type |] - | VarBr (XVarBr p) Bool (IdP p) -- True: 'x, False: ''T + = ExpBr !(XExpBr p) (LHsExpr p) -- [| expr |] + | PatBr !(XPatBr p) (LPat p) -- [p| pat |] + | DecBrL !(XDecBrL p) [LHsDecl p] -- [d| decls |]; result of parser + | DecBrG !(XDecBrG p) (HsGroup p) -- [d| decls |]; result of renamer + | TypBr !(XTypBr p) (LHsType p) -- [t| type |] + | VarBr !(XVarBr p) Bool (IdP p) -- True: 'x, False: ''T -- (The Bool flag is used only in pprHsBracket) - | TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||] + | TExpBr !(XTExpBr p) (LHsExpr p) -- [|| expr ||] | XBracket !(XXBracket p) -- Note [Trees that Grow] extension point type instance XExpBr (GhcPass _) = NoExtField ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -156,7 +156,7 @@ noExtField = NoExtField -- This should not be confused with 'NoExtField', which are found in unused -- extension /points/ (not /constructors/) and therefore can be inhabited. --- See also [NoExtCon and strict fields]. +-- See also [TTG and strict fields]. data NoExtCon deriving (Data,Eq,Ord) @@ -223,20 +223,30 @@ instance WrapXRec (GhcPass p) where wrapXRec = noLoc {- -Note [NoExtCon and strict fields] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Currently, any unused TTG extension constructor will generally look like the -following: +Note [TTG and strict fields] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The TTG extension points are all strict, note the !-annotations: - type instance XXHsDecl (GhcPass _) = NoExtCon data HsDecl p = ... + | ValD !(XValD p) (HsBind p) -- ^ Value declaration + | SigD !(XSigD p) (Sig p) -- ^ Signature declaration + | ... | XHsDecl !(XXHsDecl p) -The field of type `XXHsDecl p` is strict for a good reason: it allows the -pattern-match coverage checker to conclude that any matches against XHsDecl -are unreachable whenever `p ~ GhcPass _`. To see why this is the case, consider -the following function which consumes an HsDecl: +This allows us to selectively exclude constructors from pattern matches. One +can pick an arbitrary subset of constructors that are possible/impossible in a +particular pass. + +For example, GHC does not currently make use of XHsDecl, so it defines the +following instance: + + type instance XXHsDecl (GhcPass _) = NoExtCon + +NoExtCon is an uninhabited data type (just like Void). Since the field of type +`XXHsDecl p` is strict, the pattern-match coverage checker concludes that any +matches against XHsDecl are unreachable whenever `p ~ GhcPass _`. To see why +this is the case, consider the following function which consumes an HsDecl: ex :: HsDecl GhcPs -> HsDecl GhcRn ... @@ -250,8 +260,14 @@ inaccessible, so it can be removed. (See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for more on how this works.) -Bottom line: if you add a TTG extension constructor that uses NoExtCon, make -sure that any uses of it as a field are strict. +It is easy to recover laziness, if needed, by using a wrapper, at the cost of a +pointer indirection: + + data Box a = Box a + type instance XHsSyn MyPass = Box MyData -- The MyData field is non-strict + +Bottom line: if you add a TTG extension type family, make sure that any uses of +it as a field are strict. -} -- | Used as a data type index for the hsSyn AST; also serves @@ -331,11 +347,11 @@ type family XHsIPBinds x x' type family XEmptyLocalBinds x x' type family XXHsLocalBindsLR x x' --- ValBindsLR type families +-- HsValBindsLR type families type family XValBinds x x' type family XXValBindsLR x x' --- HsBindsLR type families +-- HsBindLR type families type family XFunBind x x' type family XPatBind x x' type family XVarBind x x' @@ -469,7 +485,7 @@ type family XCClsInstDecl x type family XXClsInstDecl x -- ------------------------------------- --- ClsInstDecl type families +-- InstDecl type families type family XClsInstD x type family XDataFamInstD x type family XTyFamInstD x @@ -490,7 +506,7 @@ type family XCDefaultDecl x type family XXDefaultDecl x -- ------------------------------------- --- DefaultDecl type families +-- ForeignDecl type families type family XForeignImport x type family XForeignExport x type family XXForeignDecl x @@ -517,7 +533,7 @@ type family XWarnings x type family XXWarnDecls x -- ------------------------------------- --- AnnDecl type families +-- WarnDecl type families type family XWarning x type family XXWarnDecl x @@ -574,32 +590,34 @@ type family XBinTick x type family XPragE x type family XXExpr x +-- ------------------------------------- +-- HsPragE type families type family XSCC x -type family XCoreAnn x -type family XTickPragma x type family XXPragE x --- --------------------------------------------------------------------- + +-- ------------------------------------- +-- AmbiguousFieldOcc type families type family XUnambiguous x type family XAmbiguous x type family XXAmbiguousFieldOcc x --- ---------------------------------------------------------------------- - +-- ------------------------------------- +-- HsTupArg type families type family XPresent x type family XMissing x type family XXTupArg x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsSplice type families type family XTypedSplice x type family XUntypedSplice x type family XQuasiQuote x type family XSpliced x type family XXSplice x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsBracket type families type family XExpBr x type family XPatBr x type family XDecBrL x @@ -609,33 +627,33 @@ type family XVarBr x type family XTExpBr x type family XXBracket x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsCmdTop type families type family XCmdTop x type family XXCmdTop x -- ------------------------------------- - +-- MatchGroup type families type family XMG x b type family XXMatchGroup x b -- ------------------------------------- - +-- Match type families type family XCMatch x b type family XXMatch x b -- ------------------------------------- - +-- GRHSs type families type family XCGRHSs x b type family XXGRHSs x b -- ------------------------------------- - +-- GRHS type families type family XCGRHS x b type family XXGRHS x b -- ------------------------------------- - +-- StmtLR type families type family XLastStmt x x' b type family XBindStmt x x' b type family XApplicativeStmt x x' b @@ -646,8 +664,8 @@ type family XTransStmt x x' b type family XRecStmt x x' b type family XXStmtLR x x' b --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsCmd type families type family XCmdArrApp x type family XCmdArrForm x type family XCmdApp x @@ -661,13 +679,13 @@ type family XCmdDo x type family XCmdWrap x type family XXCmd x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- ParStmtBlock type families type family XParStmtBlock x x' type family XXParStmtBlock x x' --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- ApplicativeArg type families type family XApplicativeArgOne x type family XApplicativeArgMany x type family XXApplicativeArg x @@ -697,6 +715,8 @@ type family XHsFloatPrim x type family XHsDoublePrim x type family XXLit x +-- ------------------------------------- +-- HsOverLit type families type family XOverLit x type family XXOverLit x @@ -725,26 +745,29 @@ type family XXPat x -- ===================================================================== -- Type families for the HsTypes type families + +-- ------------------------------------- +-- LHsQTyVars type families type family XHsQTvs x type family XXLHsQTyVars x -- ------------------------------------- - +-- HsImplicitBndrs type families type family XHsIB x b type family XXHsImplicitBndrs x b -- ------------------------------------- - +-- HsWildCardBndrs type families type family XHsWC x b type family XXHsWildCardBndrs x b -- ------------------------------------- - +-- HsPatSigType type families type family XHsPS x type family XXHsPatSigType x -- ------------------------------------- - +-- HsType type families type family XForAllTy x type family XQualTy x type family XTyVar x @@ -770,35 +793,37 @@ type family XWildCardTy x type family XXType x -- --------------------------------------------------------------------- - +-- HsForAllTelescope type families type family XHsForAllVis x type family XHsForAllInvis x type family XXHsForAllTelescope x -- --------------------------------------------------------------------- - +-- HsTyVarBndr type families type family XUserTyVar x type family XKindedTyVar x type family XXTyVarBndr x -- --------------------------------------------------------------------- - +-- ConDeclField type families type family XConDeclField x type family XXConDeclField x -- --------------------------------------------------------------------- - +-- FieldOcc type families type family XCFieldOcc x type family XXFieldOcc x -- ===================================================================== -- Type families for the HsImpExp type families +-- ------------------------------------- +-- ImportDecl type families type family XCImportDecl x type family XXImportDecl x -- ------------------------------------- - +-- IE type families type family XIEVar x type family XIEThingAbs x type family XIEThingAll x ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -79,7 +79,7 @@ isImportDeclQualified _ = True -- A single Haskell @import@ declaration. data ImportDecl pass = ImportDecl { - ideclExt :: XCImportDecl pass, + ideclExt :: !(XCImportDecl pass), ideclSourceSrc :: SourceText, -- Note [Pragma source text] in GHC.Types.Basic ideclName :: XRec pass ModuleName, -- ^ Module name. @@ -203,10 +203,10 @@ type LIE pass = XRec pass (IE pass) -- | Imported or exported entity. data IE pass - = IEVar (XIEVar pass) (LIEWrappedName (IdP pass)) + = IEVar !(XIEVar pass) (LIEWrappedName (IdP pass)) -- ^ Imported or Exported Variable - | IEThingAbs (XIEThingAbs pass) (LIEWrappedName (IdP pass)) + | IEThingAbs !(XIEThingAbs pass) (LIEWrappedName (IdP pass)) -- ^ Imported or exported Thing with Absent list -- -- The thing is a Class/Type (can't tell) @@ -215,7 +215,7 @@ data IE pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Located RdrNames] in GHC.Hs.Expr - | IEThingAll (XIEThingAll pass) (LIEWrappedName (IdP pass)) + | IEThingAll !(XIEThingAll pass) (LIEWrappedName (IdP pass)) -- ^ Imported or exported Thing with All imported or exported -- -- The thing is a Class/Type and the All refers to methods/constructors @@ -227,7 +227,7 @@ data IE pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation -- See Note [Located RdrNames] in GHC.Hs.Expr - | IEThingWith (XIEThingWith pass) + | IEThingWith !(XIEThingWith pass) (LIEWrappedName (IdP pass)) IEWildcard [LIEWrappedName (IdP pass)] @@ -242,7 +242,7 @@ data IE pass -- 'GHC.Parser.Annotation.AnnType' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName) + | IEModuleContents !(XIEModuleContents pass) (XRec pass ModuleName) -- ^ Imported or exported module contents -- -- (Export Only) @@ -250,9 +250,9 @@ data IE pass -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | IEGroup (XIEGroup pass) Int HsDocString -- ^ Doc section heading - | IEDoc (XIEDoc pass) HsDocString -- ^ Some documentation - | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc + | IEGroup !(XIEGroup pass) Int HsDocString -- ^ Doc section heading + | IEDoc !(XIEDoc pass) HsDocString -- ^ Some documentation + | IEDocNamed !(XIEDocNamed pass) String -- ^ Reference to named doc | XIE !(XXIE pass) type instance XIEVar (GhcPass _) = NoExtField ===================================== compiler/GHC/Hs/Lit.hs ===================================== @@ -48,36 +48,36 @@ import Data.Data hiding ( Fixity ) -- Note [Trees that grow] in GHC.Hs.Extension for the Xxxxx fields in the following -- | Haskell Literal data HsLit x - = HsChar (XHsChar x) {- SourceText -} Char + = HsChar !(XHsChar x) {- SourceText -} Char -- ^ Character - | HsCharPrim (XHsCharPrim x) {- SourceText -} Char + | HsCharPrim !(XHsCharPrim x) {- SourceText -} Char -- ^ Unboxed character - | HsString (XHsString x) {- SourceText -} FastString + | HsString !(XHsString x) {- SourceText -} FastString -- ^ String - | HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString + | HsStringPrim !(XHsStringPrim x) {- SourceText -} !ByteString -- ^ Packed bytes - | HsInt (XHsInt x) IntegralLit + | HsInt !(XHsInt x) IntegralLit -- ^ Genuinely an Int; arises from -- "GHC.Tc.Deriv.Generate", and from TRANSLATION - | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer + | HsIntPrim !(XHsIntPrim x) {- SourceText -} Integer -- ^ literal @Int#@ - | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer + | HsWordPrim !(XHsWordPrim x) {- SourceText -} Integer -- ^ literal @Word#@ - | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer + | HsInt64Prim !(XHsInt64Prim x) {- SourceText -} Integer -- ^ literal @Int64#@ - | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer + | HsWord64Prim !(XHsWord64Prim x) {- SourceText -} Integer -- ^ literal @Word64#@ - | HsInteger (XHsInteger x) {- SourceText -} Integer Type + | HsInteger !(XHsInteger x) {- SourceText -} Integer Type -- ^ Genuinely an integer; arises only -- from TRANSLATION (overloaded -- literals are done with HsOverLit) - | HsRat (XHsRat x) FractionalLit Type + | HsRat !(XHsRat x) FractionalLit Type -- ^ Genuinely a rational; arises only from -- TRANSLATION (overloaded literals are -- done with HsOverLit) - | HsFloatPrim (XHsFloatPrim x) FractionalLit + | HsFloatPrim !(XHsFloatPrim x) FractionalLit -- ^ Unboxed Float - | HsDoublePrim (XHsDoublePrim x) FractionalLit + | HsDoublePrim !(XHsDoublePrim x) FractionalLit -- ^ Unboxed Double | XLit !(XXLit x) @@ -116,7 +116,7 @@ instance Eq (HsLit x) where -- | Haskell Overloaded Literal data HsOverLit p = OverLit { - ol_ext :: (XOverLit p), + ol_ext :: !(XOverLit p), ol_val :: OverLitVal, ol_witness :: HsExpr p} -- Note [Overloaded literal witnesses] ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -87,42 +87,42 @@ type LPat p = XRec p (Pat p) -- For details on above see note [Api annotations] in GHC.Parser.Annotation data Pat p = ------------ Simple patterns --------------- - WildPat (XWildPat p) -- ^ Wildcard Pattern + WildPat !(XWildPat p) -- ^ Wildcard Pattern -- The sole reason for a type on a WildPat is to -- support hsPatType :: Pat Id -> Type -- AZ:TODO above comment needs to be updated - | VarPat (XVarPat p) + | VarPat !(XVarPat p) (LIdP p) -- ^ Variable Pattern -- See Note [Located RdrNames] in GHC.Hs.Expr - | LazyPat (XLazyPat p) + | LazyPat !(XLazyPat p) (LPat p) -- ^ Lazy Pattern -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | AsPat (XAsPat p) + | AsPat !(XAsPat p) (LIdP p) (LPat p) -- ^ As pattern -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | ParPat (XParPat p) + | ParPat !(XParPat p) (LPat p) -- ^ Parenthesised pattern -- See Note [Parens in HsSyn] in GHC.Hs.Expr -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | BangPat (XBangPat p) + | BangPat !(XBangPat p) (LPat p) -- ^ Bang pattern -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang' -- For details on above see note [Api annotations] in GHC.Parser.Annotation ------------ Lists, tuples, arrays --------------- - | ListPat (XListPat p) + | ListPat !(XListPat p) [LPat p] -- For OverloadedLists a Just (ty,fn) gives -- overall type of the pattern, and the toList @@ -135,7 +135,7 @@ data Pat p -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | TuplePat (XTuplePat p) + | TuplePat !(XTuplePat p) -- after typechecking, holds the types of the tuple components [LPat p] -- Tuple sub-patterns Boxity -- UnitPat is TuplePat [] @@ -161,7 +161,7 @@ data Pat p -- 'GHC.Parser.Annotation.AnnOpen' @'('@ or @'(#'@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ or @'#)'@ - | SumPat (XSumPat p) -- after typechecker, types of the alternative + | SumPat !(XSumPat p) -- after typechecker, types of the alternative (LPat p) -- Sum sub-pattern ConTag -- Alternative (one-based) Arity -- Arity (INVARIANT: ≥ 2) @@ -175,7 +175,7 @@ data Pat p ------------ Constructor patterns --------------- | ConPat { - pat_con_ext :: XConPat p, + pat_con_ext :: !(XConPat p), pat_con :: XRec p (ConLikeP p), pat_args :: HsConPatDetails p } @@ -185,7 +185,7 @@ data Pat p -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | ViewPat (XViewPat p) -- The overall type of the pattern + | ViewPat !(XViewPat p) -- The overall type of the pattern -- (= the argument type of the view function) -- for hsPatType. (LHsExpr p) @@ -197,11 +197,11 @@ data Pat p -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | SplicePat (XSplicePat p) + | SplicePat !(XSplicePat p) (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes) ------------ Literal and n+k patterns --------------- - | LitPat (XLitPat p) + | LitPat !(XLitPat p) (HsLit p) -- ^ Literal Pattern -- Used for *non-overloaded* literal patterns: -- Int#, Char#, Int, Char, String, etc. @@ -209,7 +209,7 @@ data Pat p | NPat -- Natural Pattern -- Used for all overloaded literals, -- including overloaded strings with -XOverloadedStrings - (XNPat p) -- Overall type of pattern. Might be + !(XNPat p) -- Overall type of pattern. Might be -- different than the literal's type -- if (==) or negate changes the type (XRec p (HsOverLit p)) -- ALWAYS positive @@ -223,7 +223,7 @@ data Pat p -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnVal' @'+'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | NPlusKPat (XNPlusKPat p) -- Type of overall pattern + | NPlusKPat !(XNPlusKPat p) -- Type of overall pattern (LIdP p) -- n+k pattern (XRec p (HsOverLit p)) -- It'll always be an HsIntegral (HsOverLit p) -- See Note [NPlusK patterns] in GHC.Tc.Gen.Pat @@ -238,7 +238,7 @@ data Pat p -- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | SigPat (XSigPat p) -- After typechecker: Type + | SigPat !(XSigPat p) -- After typechecker: Type (LPat p) -- Pattern with a type signature (HsPatSigType (NoGhcTc p)) -- Signature can bind both -- kind and type vars ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -345,12 +345,12 @@ data HsForAllTelescope pass = HsForAllVis -- ^ A visible @forall@ (e.g., @forall a -> {...}@). -- These do not have any notion of specificity, so we use -- '()' as a placeholder value. - { hsf_xvis :: XHsForAllVis pass + { hsf_xvis :: !(XHsForAllVis pass) , hsf_vis_bndrs :: [LHsTyVarBndr () pass] } | HsForAllInvis -- ^ An invisible @forall@ (e.g., @forall a {b} c. {...}@), -- where each binder has a 'Specificity'. - { hsf_xinvis :: XHsForAllInvis pass + { hsf_xinvis :: !(XHsForAllInvis pass) , hsf_invis_bndrs :: [LHsTyVarBndr Specificity pass] } | XHsForAllTelescope !(XXHsForAllTelescope pass) @@ -366,7 +366,7 @@ type LHsTyVarBndr flag pass = XRec pass (HsTyVarBndr flag pass) -- | Located Haskell Quantified Type Variables data LHsQTyVars pass -- See Note [HsType binders] - = HsQTvs { hsq_ext :: XHsQTvs pass + = HsQTvs { hsq_ext :: !(XHsQTvs pass) , hsq_explicit :: [LHsTyVarBndr () pass] -- Explicit variables, written by the user @@ -410,7 +410,7 @@ emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] } -- | Haskell Implicit Binders data HsImplicitBndrs pass thing -- See Note [HsType binders] - = HsIB { hsib_ext :: XHsIB pass thing -- after renamer: [Name] + = HsIB { hsib_ext :: !(XHsIB pass thing) -- after renamer: [Name] -- Implicitly-bound kind & type vars -- Order is important; see -- Note [Ordering of implicit variables] @@ -430,7 +430,7 @@ type instance XXHsImplicitBndrs (GhcPass _) _ = NoExtCon data HsWildCardBndrs pass thing -- See Note [HsType binders] -- See Note [The wildcard story for types] - = HsWC { hswc_ext :: XHsWC pass thing + = HsWC { hswc_ext :: !(XHsWC pass thing) -- after the renamer -- Wild cards, only named -- See Note [Wildcards in visible kind application] @@ -456,7 +456,7 @@ type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon -- slightly different semantics: see @Note [HsType binders]@. -- See also @Note [The wildcard story for types]@. data HsPatSigType pass - = HsPS { hsps_ext :: XHsPS pass -- ^ After renamer: 'HsPSRn' + = HsPS { hsps_ext :: !(XHsPS pass) -- ^ After renamer: 'HsPSRn' , hsps_body :: LHsType pass -- ^ Main payload (the type itself) } | XHsPatSigType !(XXHsPatSigType pass) @@ -635,13 +635,13 @@ instance OutputableBndr HsIPName where -- '()' in other places. data HsTyVarBndr flag pass = UserTyVar -- no explicit kinding - (XUserTyVar pass) + !(XUserTyVar pass) flag (LIdP pass) -- See Note [Located RdrNames] in GHC.Hs.Expr | KindedTyVar - (XKindedTyVar pass) + !(XKindedTyVar pass) flag (LIdP pass) (LHsKind pass) -- The user-supplied kind signature @@ -687,7 +687,7 @@ instance NamedThing (HsTyVarBndr flag GhcRn) where -- | Haskell Type data HsType pass = HsForAllTy -- See Note [HsType binders] - { hst_xforall :: XForAllTy pass + { hst_xforall :: !(XForAllTy pass) , hst_tele :: HsForAllTelescope pass -- Explicit, user-supplied 'forall a {b} c' , hst_body :: LHsType pass -- body type @@ -697,11 +697,11 @@ data HsType pass -- For details on above see note [Api annotations] in "GHC.Parser.Annotation" | HsQualTy -- See Note [HsType binders] - { hst_xqual :: XQualTy pass + { hst_xqual :: !(XQualTy pass) , hst_ctxt :: LHsContext pass -- Context C => blah , hst_body :: LHsType pass } - | HsTyVar (XTyVar pass) + | HsTyVar !(XTyVar pass) PromotionFlag -- Whether explicitly promoted, -- for the pretty printer (LIdP pass) @@ -712,18 +712,18 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsAppTy (XAppTy pass) + | HsAppTy !(XAppTy pass) (LHsType pass) (LHsType pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsAppKindTy (XAppKindTy pass) -- type level type app + | HsAppKindTy !(XAppKindTy pass) -- type level type app (LHsType pass) (LHsKind pass) - | HsFunTy (XFunTy pass) + | HsFunTy !(XFunTy pass) (HsArrow pass) (LHsType pass) -- function type (LHsType pass) @@ -731,14 +731,14 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsListTy (XListTy pass) + | HsListTy !(XListTy pass) (LHsType pass) -- Element type -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'['@, -- 'GHC.Parser.Annotation.AnnClose' @']'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsTupleTy (XTupleTy pass) + | HsTupleTy !(XTupleTy pass) HsTupleSort [LHsType pass] -- Element types (length gives arity) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(' or '(#'@, @@ -746,20 +746,20 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsSumTy (XSumTy pass) + | HsSumTy !(XSumTy pass) [LHsType pass] -- Element types (length gives arity) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'(#'@, -- 'GHC.Parser.Annotation.AnnClose' '#)'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsOpTy (XOpTy pass) + | HsOpTy !(XOpTy pass) (LHsType pass) (LIdP pass) (LHsType pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsParTy (XParTy pass) + | HsParTy !(XParTy pass) (LHsType pass) -- See Note [Parens in HsSyn] in GHC.Hs.Expr -- Parenthesis preserved for the precedence re-arrangement in -- GHC.Rename.HsType @@ -769,7 +769,7 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsIParamTy (XIParamTy pass) + | HsIParamTy !(XIParamTy pass) (XRec pass HsIPName) -- (?x :: ty) (LHsType pass) -- Implicit parameters as they occur in -- contexts @@ -780,12 +780,12 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsStarTy (XStarTy pass) + | HsStarTy !(XStarTy pass) Bool -- Is this the Unicode variant? -- Note [HsStarTy] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None - | HsKindSig (XKindSig pass) + | HsKindSig !(XKindSig pass) (LHsType pass) -- (ty :: kind) (LHsKind pass) -- A type with a kind signature -- ^ @@ -796,20 +796,20 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsSpliceTy (XSpliceTy pass) + | HsSpliceTy !(XSpliceTy pass) (HsSplice pass) -- Includes quasi-quotes -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsDocTy (XDocTy pass) + | HsDocTy !(XDocTy pass) (LHsType pass) LHsDocString -- A documented type -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsBangTy (XBangTy pass) + | HsBangTy !(XBangTy pass) HsSrcBang (LHsType pass) -- Bang-style type annotations -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : -- 'GHC.Parser.Annotation.AnnOpen' @'{-\# UNPACK' or '{-\# NOUNPACK'@, @@ -818,7 +818,7 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsRecTy (XRecTy pass) + | HsRecTy !(XRecTy pass) [LConDeclField pass] -- Only in data type declarations -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'{'@, -- 'GHC.Parser.Annotation.AnnClose' @'}'@ @@ -832,7 +832,7 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsExplicitListTy -- A promoted explicit list - (XExplicitListTy pass) + !(XExplicitListTy pass) PromotionFlag -- whether explicitly promoted, for pretty printer [LHsType pass] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'["@, @@ -841,19 +841,19 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsExplicitTupleTy -- A promoted explicit tuple - (XExplicitTupleTy pass) + !(XExplicitTupleTy pass) [LHsType pass] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @"'("@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsTyLit (XTyLit pass) HsTyLit -- A promoted numeric literal. + | HsTyLit !(XTyLit pass) HsTyLit -- A promoted numeric literal. -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsWildCardTy (XWildCardTy pass) -- A type wildcard + | HsWildCardTy !(XWildCardTy pass) -- A type wildcard -- See Note [The wildcard story for types] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None @@ -861,7 +861,7 @@ data HsType pass -- For adding new constructors via Trees that Grow | XHsType - (XXType pass) + !(XXType pass) data NewHsTypeX = NHsCoreTy Type -- An escape hatch for tunnelling a *closed* @@ -1083,7 +1083,7 @@ type LConDeclField pass = XRec pass (ConDeclField pass) -- | Constructor Declaration Field data ConDeclField pass -- Record fields have Haddock docs on them - = ConDeclField { cd_fld_ext :: XConDeclField pass, + = ConDeclField { cd_fld_ext :: !(XConDeclField pass), cd_fld_names :: [LFieldOcc pass], -- ^ See Note [ConDeclField passs] cd_fld_type :: LBangType pass, @@ -1680,7 +1680,7 @@ type LFieldOcc pass = XRec pass (FieldOcc pass) -- Represents an *occurrence* of an unambiguous field. We store -- both the 'RdrName' the user originally wrote, and after the -- renamer, the selector function. -data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass +data FieldOcc pass = FieldOcc { extFieldOcc :: !(XCFieldOcc pass) , rdrNameFieldOcc :: Located RdrName -- ^ See Note [Located RdrNames] in "GHC.Hs.Expr" } @@ -1715,8 +1715,8 @@ mkFieldOcc rdr = FieldOcc noExtField rdr -- Note [Disambiguating record fields] in "GHC.Tc.Gen.Head". -- See Note [Located RdrNames] in "GHC.Hs.Expr" data AmbiguousFieldOcc pass - = Unambiguous (XUnambiguous pass) (Located RdrName) - | Ambiguous (XAmbiguous pass) (Located RdrName) + = Unambiguous !(XUnambiguous pass) (Located RdrName) + | Ambiguous !(XAmbiguous pass) (Located RdrName) | XAmbiguousFieldOcc !(XXAmbiguousFieldOcc pass) type instance XUnambiguous GhcPs = NoExtField View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b91e136c2e4d464f4cc7da81b344d5d96336d60 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b91e136c2e4d464f4cc7da81b344d5d96336d60 You're receiving 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 30 10:09:18 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 06:09:18 -0400 Subject: [Git][ghc/ghc][wip/T18765] s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) Message-ID: <5f74594e4b63e_80b3f8486b9c04015571674@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18765 at Glasgow Haskell Compiler / GHC Commits: 0cf95256 by Sebastian Graf at 2020-09-30T11:40:10+02:00 s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) This defeats constant-folding in the final phases of the Simplifier, but enables us to get rid of allocations by inlining calls that can't be constant-folded. `NOINLINE[0]` is a better choice than `NOINLINE`, because 1. We still delay inlining long enough for the constant-folding RULEs to fire 2. The compiler has the option to inlining them late, possibly cancelling away boxes in the process. `NOINLINE[0]` is a better choice than `INLINE[0]`, because 3. We don't unconditionally inline huge definitions such as `integerDiv`, which would lead to code bloat at pretty much no gain. 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. `integerDiv`, there is no gain in inlining the unoptimised unfoldings. Fixes #18765. - - - - - 1 changed file: - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -66,6 +66,7 @@ integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND -- | Check Integer invariants integerCheck :: Integer -> Bool +{-# INLINE integerCheck #-} integerCheck i = isTrue# (integerCheck# i) -- | Integer Zero @@ -145,18 +146,19 @@ integerFromInt (I# i) = IS i -- | Truncates 'Integer' to least-significant 'Int#' integerToInt# :: Integer -> Int# -{-# NOINLINE integerToInt# #-} +{-# NOINLINE[0] integerToInt# #-} integerToInt# (IS i) = i integerToInt# (IP b) = word2Int# (bigNatToWord# b) integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) -- | Truncates 'Integer' to least-significant 'Int#' integerToInt :: Integer -> Int +{-# INLINE integerToInt #-} integerToInt i = I# (integerToInt# i) -- | Convert a Word# into an Integer integerFromWord# :: Word# -> Integer -{-# NOINLINE integerFromWord# #-} +{-# NOINLINE[0] integerFromWord# #-} integerFromWord# w | i <- word2Int# w , isTrue# (i >=# 0#) @@ -167,6 +169,7 @@ integerFromWord# w -- | Convert a Word into an Integer integerFromWord :: Word -> Integer +{-# INLINE integerFromWord #-} integerFromWord (W# w) = integerFromWord# w -- | Create a negative Integer with the given Word magnitude @@ -185,23 +188,25 @@ integerFromWordSign# _ w = integerFromWordNeg# w -- | Truncate an Integer into a Word integerToWord# :: Integer -> Word# -{-# NOINLINE integerToWord# #-} +{-# NOINLINE[0] integerToWord# #-} integerToWord# (IS i) = int2Word# i integerToWord# (IP bn) = bigNatToWord# bn integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) -- | Truncate an Integer into a Word integerToWord :: Integer -> Word +{-# INLINE integerToWord #-} integerToWord !i = W# (integerToWord# i) -- | Convert a Natural into an Integer integerFromNatural :: Natural -> Integer -{-# NOINLINE integerFromNatural #-} +{-# NOINLINE[0] integerFromNatural #-} integerFromNatural (NS x) = integerFromWord# x integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer +{-# INLINE integerFromWordList #-} integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) @@ -209,7 +214,7 @@ integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- -- Return 0 for negative Integers. integerToNaturalClamp :: Integer -> Natural -{-# NOINLINE integerToNaturalClamp #-} +{-# NOINLINE[0] integerToNaturalClamp #-} integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) @@ -220,7 +225,7 @@ integerToNaturalClamp (IN _) = naturalZero -- -- Return absolute value integerToNatural :: Integer -> Natural -{-# NOINLINE integerToNatural #-} +{-# NOINLINE[0] integerToNatural #-} integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x @@ -237,40 +242,48 @@ integerIsNegative# (IN _) = 1# -- | Negative predicate integerIsNegative :: Integer -> Bool +{-# INLINE integerIsNegative #-} integerIsNegative !i = isTrue# (integerIsNegative# i) -- | Zero predicate integerIsZero :: Integer -> Bool +{-# INLINE integerIsZero #-} integerIsZero (IS 0#) = True integerIsZero _ = False -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool +{-# INLINE integerNe #-} integerNe !x !y = isTrue# (integerNe# x y) -- | Equal predicate. integerEq :: Integer -> Integer -> Bool +{-# INLINE integerEq #-} integerEq !x !y = isTrue# (integerEq# x y) -- | Lower-or-equal predicate. integerLe :: Integer -> Integer -> Bool +{-# INLINE integerLe #-} integerLe !x !y = isTrue# (integerLe# x y) -- | Lower predicate. integerLt :: Integer -> Integer -> Bool +{-# INLINE integerLt #-} integerLt !x !y = isTrue# (integerLt# x y) -- | Greater predicate. integerGt :: Integer -> Integer -> Bool +{-# INLINE integerGt #-} integerGt !x !y = isTrue# (integerGt# x y) -- | Greater-or-equal predicate. integerGe :: Integer -> Integer -> Bool +{-# INLINE integerGe #-} integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} +{-# NOINLINE[0] integerEq# #-} integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -278,7 +291,7 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} +{-# NOINLINE[0] integerNe# #-} integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -286,39 +299,41 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} +{-# NOINLINE[0] integerGt# #-} integerGt# (IS x) (IS y) = x ># y integerGt# x y | GT <- integerCompare x y = 1# integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} +{-# NOINLINE[0] integerLe# #-} integerLe# (IS x) (IS y) = x <=# y integerLe# x y | GT <- integerCompare x y = 0# integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} +{-# NOINLINE[0] integerLt# #-} integerLt# (IS x) (IS y) = x <# y integerLt# x y | LT <- integerCompare x y = 1# integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} +{-# NOINLINE[0] integerGe# #-} integerGe# (IS x) (IS y) = x >=# y integerGe# x y | LT <- integerCompare x y = 0# integerGe# _ _ = 1# instance Eq Integer where + {-# INLINE (==) #-} (==) = integerEq + {-# INLINE (/=) #-} (/=) = integerNe -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} +{-# NOINLINE[0] integerCompare #-} integerCompare (IS x) (IS y) = compareInt# x y integerCompare (IP x) (IP y) = bigNatCompare x y integerCompare (IN x) (IN y) = bigNatCompare y x @@ -330,6 +345,7 @@ integerCompare (IP _) (IN _) = GT integerCompare (IN _) (IP _) = LT instance Ord Integer where + {-# INLINE compare #-} compare = integerCompare --------------------------------------------------------------------- @@ -338,7 +354,7 @@ instance Ord Integer where -- | Subtract one 'Integer' from another. integerSub :: Integer -> Integer -> Integer -{-# NOINLINE integerSub #-} +{-# NOINLINE[0] integerSub #-} integerSub !x (IS 0#) = x integerSub (IS x#) (IS y#) = case subIntC# x# y# of @@ -384,7 +400,7 @@ integerSub (IN x) (IS y#) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer -{-# NOINLINE integerAdd #-} +{-# NOINLINE[0] integerAdd #-} integerAdd !x (IS 0#) = x integerAdd (IS 0#) y = y integerAdd (IS x#) (IS y#) @@ -413,7 +429,7 @@ integerAdd (IP x) (IN y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer -{-# NOINLINE integerMul #-} +{-# NOINLINE[0] integerMul #-} integerMul !_ (IS 0#) = IS 0# integerMul (IS 0#) _ = IS 0# integerMul x (IS 1#) = x @@ -478,7 +494,7 @@ integerMul (IN x) (IS y) -- IP is used iff n > maxBound::Int -- IN is used iff n < minBound::Int integerNegate :: Integer -> Integer -{-# NOINLINE integerNegate #-} +{-# NOINLINE[0] integerNegate #-} integerNegate (IN b) = IP b integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) integerNegate (IS i) = IS (negateInt# i) @@ -489,7 +505,7 @@ integerNegate (IP b) -- | Compute absolute value of an 'Integer' integerAbs :: Integer -> Integer -{-# NOINLINE integerAbs #-} +{-# NOINLINE[0] integerAbs #-} integerAbs (IN i) = IP i integerAbs n@(IP _) = n integerAbs n@(IS i) @@ -501,13 +517,13 @@ integerAbs n@(IS i) -- | Return @-1@, @0@, and @1@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum :: Integer -> Integer -{-# NOINLINE integerSignum #-} +{-# NOINLINE[0] integerSignum #-} integerSignum !j = IS (integerSignum# j) -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum# :: Integer -> Int# -{-# NOINLINE integerSignum# #-} +{-# NOINLINE[0] integerSignum# #-} integerSignum# (IN _) = -1# integerSignum# (IS i#) = sgnI# i# integerSignum# (IP _ ) = 1# @@ -515,7 +531,7 @@ integerSignum# (IP _ ) = 1# -- | Count number of set bits. For negative arguments returns -- the negated population count of the absolute value. integerPopCount# :: Integer -> Int# -{-# NOINLINE integerPopCount# #-} +{-# NOINLINE[0] integerPopCount# #-} integerPopCount# (IS i) | isTrue# (i >=# 0#) = word2Int# (popCntI# i) | True = negateInt# (word2Int# (popCntI# (negateInt# i))) @@ -524,7 +540,7 @@ integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) -- | Positive 'Integer' for which only /n/-th bit is set integerBit# :: Word# -> Integer -{-# NOINLINE integerBit# #-} +{-# NOINLINE[0] integerBit# #-} integerBit# i | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) = IS (uncheckedIShiftL# 1# (word2Int# i)) @@ -533,13 +549,14 @@ integerBit# i -- | 'Integer' for which only /n/-th bit is set integerBit :: Word -> Integer +{-# INLINE integerBit #-} integerBit (W# i) = integerBit# i -- | Test if /n/-th bit is set. -- -- Fake 2's complement for negative values (might be slow) integerTestBit# :: Integer -> Word# -> Bool# -{-# NOINLINE integerTestBit# #-} +{-# NOINLINE[0] integerTestBit# #-} integerTestBit# (IS x) i | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = testBitI# x i @@ -569,13 +586,14 @@ integerTestBit# (IN x) i -- -- Fake 2's complement for negative values (might be slow) integerTestBit :: Integer -> Word -> Bool +{-# INLINE integerTestBit #-} integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) -- | Shift-right operation -- -- Fake 2's complement for negative values (might be slow) integerShiftR# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftR# #-} +{-# NOINLINE[0] integerShiftR# #-} integerShiftR# !x 0## = x integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) where @@ -592,11 +610,12 @@ integerShiftR# (IN bn) n = -- -- Fake 2's complement for negative values (might be slow) integerShiftR :: Integer -> Word -> Integer +{-# INLINE integerShiftR #-} integerShiftR !x (W# w) = integerShiftR# x w -- | Shift-left operation integerShiftL# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftL# #-} +{-# NOINLINE[0] integerShiftL# #-} integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n @@ -611,13 +630,14 @@ integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) -- Remember that bits are stored in sign-magnitude form, hence the behavior of -- negative Integers is different from negative Int's behavior. integerShiftL :: Integer -> Word -> Integer +{-# INLINE integerShiftL #-} integerShiftL !x (W# w) = integerShiftL# x w -- | Bitwise OR operation -- -- Fake 2's complement for negative values (might be slow) integerOr :: Integer -> Integer -> Integer -{-# NOINLINE integerOr #-} +{-# NOINLINE[0] integerOr #-} integerOr a b = case a of IS 0# -> b IS -1# -> IS -1# @@ -676,7 +696,7 @@ integerOr a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerXor :: Integer -> Integer -> Integer -{-# NOINLINE integerXor #-} +{-# NOINLINE[0] integerXor #-} integerXor a b = case a of IS 0# -> b IS -1# -> integerComplement b @@ -731,7 +751,7 @@ integerXor a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerAnd :: Integer -> Integer -> Integer -{-# NOINLINE integerAnd #-} +{-# NOINLINE[0] integerAnd #-} integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> b @@ -766,7 +786,7 @@ integerAnd a b = case a of -- | Binary complement of the integerComplement :: Integer -> Integer -{-# NOINLINE integerComplement #-} +{-# NOINLINE[0] integerComplement #-} integerComplement (IS x) = IS (notI# x) integerComplement (IP x) = IN (bigNatAddWord# x 1##) integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) @@ -777,7 +797,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerQuotRem# #-} +{-# NOINLINE[0] integerQuotRem# #-} integerQuotRem# !n (IS 1#) = (# n, IS 0# #) integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) integerQuotRem# !_ (IS 0#) = case raiseDivZero of @@ -815,12 +835,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerQuotRem #-} integerQuotRem !x !y = case integerQuotRem# x y of (# q, r #) -> (q, r) integerQuot :: Integer -> Integer -> Integer -{-# NOINLINE integerQuot #-} +{-# NOINLINE[0] integerQuot #-} integerQuot !n (IS 1#) = n integerQuot !n (IS -1#) = integerNegate n integerQuot !_ (IS 0#) = raiseDivZero @@ -841,7 +862,7 @@ integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer -{-# NOINLINE integerRem #-} +{-# NOINLINE[0] integerRem #-} integerRem !_ (IS 1#) = IS 0# integerRem _ (IS -1#) = IS 0# integerRem _ (IS 0#) = IS (remInt# 0# 0#) @@ -863,7 +884,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerDivMod# #-} +{-# NOINLINE[0] integerDivMod# #-} integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) = let !q' = integerSub q (IS 1#) @@ -878,12 +899,13 @@ integerDivMod# !n !d -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerDivMod #-} integerDivMod !n !d = case integerDivMod# n d of (# q,r #) -> (q,r) integerDiv :: Integer -> Integer -> Integer -{-# NOINLINE integerDiv #-} +{-# NOINLINE[0] integerDiv #-} integerDiv !n !d -- same-sign ops can be handled by more efficient 'integerQuot' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d @@ -891,7 +913,7 @@ integerDiv !n !d integerMod :: Integer -> Integer -> Integer -{-# NOINLINE integerMod #-} +{-# NOINLINE[0] integerMod #-} integerMod !n !d -- same-sign ops can be handled by more efficient 'integerRem' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d @@ -899,7 +921,7 @@ integerMod !n !d -- | Compute greatest common divisor. integerGcd :: Integer -> Integer -> Integer -{-# NOINLINE integerGcd #-} +{-# NOINLINE[0] integerGcd #-} integerGcd (IS 0#) !b = integerAbs b integerGcd a (IS 0#) = integerAbs a integerGcd (IS 1#) _ = IS 1# @@ -917,7 +939,7 @@ integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (ab -- | Compute least common multiple. integerLcm :: Integer -> Integer -> Integer -{-# NOINLINE integerLcm #-} +{-# NOINLINE[0] integerLcm #-} integerLcm (IS 0#) !_ = IS 0# integerLcm (IS 1#) b = integerAbs b integerLcm (IS -1#) b = integerAbs b @@ -931,6 +953,7 @@ integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab -- | Square a Integer integerSqr :: Integer -> Integer +{-# INLINE integerSqr #-} integerSqr !a = integerMul a a @@ -948,6 +971,7 @@ integerLog2# (IP b) = bigNatLog2# b -- -- For numbers <= 0, return 0 integerLog2 :: Integer -> Word +{-# INLINE integerLog2 #-} integerLog2 !i = W# (integerLog2# i) -- | Logarithm (floor) for an arbitrary base @@ -962,6 +986,7 @@ integerLogBaseWord# base !i -- -- For numbers <= 0, return 0 integerLogBaseWord :: Word -> Integer -> Word +{-# INLINE integerLogBaseWord #-} integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) -- | Logarithm (floor) for an arbitrary base @@ -977,6 +1002,7 @@ integerLogBase# !base !i -- -- For numbers <= 0, return 0 integerLogBase :: Integer -> Integer -> Word +{-# INLINE integerLogBase #-} integerLogBase !base !i = W# (integerLogBase# base i) -- | Indicate if the value is a power of two and which one @@ -991,7 +1017,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer on 32-bit architectures integerFromInt64# :: Int64# -> Integer -{-# NOINLINE integerFromInt64# #-} +{-# NOINLINE[0] integerFromInt64# #-} integerFromInt64# !i | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) &&# (i `geInt64#` intToInt64# -0x80000000#)) @@ -1005,7 +1031,7 @@ integerFromInt64# !i -- | Convert a Word64# into an Integer on 32-bit architectures integerFromWord64# :: Word64# -> Integer -{-# NOINLINE integerFromWord64# #-} +{-# NOINLINE[0] integerFromWord64# #-} integerFromWord64# !w | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) = IS (int64ToInt# (word64ToInt64# w)) @@ -1014,14 +1040,14 @@ integerFromWord64# !w -- | Convert an Integer into an Int64# on 32-bit architectures integerToInt64# :: Integer -> Int64# -{-# NOINLINE integerToInt64# #-} +{-# NOINLINE[0] integerToInt64# #-} integerToInt64# (IS i) = intToInt64# i integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) -- | Convert an Integer into a Word64# on 32-bit architectures integerToWord64# :: Integer -> Word64# -{-# NOINLINE integerToWord64# #-} +{-# NOINLINE[0] integerToWord64# #-} integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) integerToWord64# (IP b) = bigNatToWord64# b integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) @@ -1040,18 +1066,19 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# NOINLINE[0] integerDecodeDouble# #-} integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble :: Double -> (Integer, Int) +{-# INLINE integerDecodeDouble #-} integerDecodeDouble (D# x) = case integerDecodeDouble# x of (# m, e #) -> (m, I# e) -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# -{-# NOINLINE integerEncodeDouble# #-} +{-# NOINLINE[0] integerEncodeDouble# #-} integerEncodeDouble# (IS i) 0# = int2Double# i integerEncodeDouble# (IS i) e = intEncodeDouble# i e integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e @@ -1059,23 +1086,24 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) -- | Encode (Integer mantissa, Int exponent) into a Double integerEncodeDouble :: Integer -> Int -> Double +{-# INLINE integerEncodeDouble #-} integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) -- | Encode an Integer (mantissa) into a Double# integerToDouble# :: Integer -> Double# -{-# NOINLINE integerToDouble# #-} +{-# NOINLINE[0] integerToDouble# #-} integerToDouble# !i = integerEncodeDouble# i 0# -- | Encode an Integer (mantissa) into a Float# integerToFloat# :: Integer -> Float# -{-# NOINLINE integerToFloat# #-} +{-# NOINLINE[0] integerToFloat# #-} integerToFloat# !i = integerEncodeFloat# i 0# -- | Encode (# Integer mantissa, Int# exponent #) into a Float# -- -- TODO: Not sure if it's worth to write 'Float' optimized versions here integerEncodeFloat# :: Integer -> Int# -> Float# -{-# NOINLINE integerEncodeFloat# #-} +{-# NOINLINE[0] integerEncodeFloat# #-} integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) @@ -1105,6 +1133,7 @@ integerToAddr# (IN n) = bigNatToAddr# n -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +{-# INLINE integerToAddr #-} integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1132,6 +1161,7 @@ integerFromAddr# sz addr e s = -- -- Null higher limbs are automatically trimed. integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +{-# INLINE integerFromAddr #-} integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) @@ -1154,6 +1184,7 @@ integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +{-# INLINE integerToMutableByteArray #-} integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of (# s', r #) -> (# s', W# r #) @@ -1180,6 +1211,7 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of -- -- Null higher limbs are automatically trimed. integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +{-# INLINE integerFromByteArray #-} integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i @@ -1212,5 +1244,6 @@ integerGcde :: Integer -> Integer -> ( Integer, Integer, Integer) +{-# INLINE integerGcde #-} integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cf9525638b715cdecc8c97d9ac3c7a526cd6948 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cf9525638b715cdecc8c97d9ac3c7a526cd6948 You're receiving 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 30 10:23:57 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Wed, 30 Sep 2020 06:23:57 -0400 Subject: [Git][ghc/ghc][wip/andreask/winio_atomics] WinIO: Small changes related to atomic request swaps. Message-ID: <5f745cbd8eb18_80b6d647e0155770e4@gitlab.haskell.org.mail> Andreas Klebinger pushed to branch wip/andreask/winio_atomics at Glasgow Haskell Compiler / GHC Commits: 5e00d926 by Andreas Klebinger at 2020-09-30T12:23:31+02:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - libraries/base/GHC/Event/Internal.hs - libraries/base/GHC/Event/Windows.hsc - libraries/base/GHC/Ptr.hs - libraries/ghc-prim/changelog.md - testsuite/tests/codeGen/should_compile/cg011.hs - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/codeGen/should_run/cas_int.hs - + testsuite/tests/codeGen/should_run/cas_int.stdout - testsuite/tests/codeGen/should_run/cgrun080.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2527,18 +2527,40 @@ primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp with has_side_effects = True can_fail = True -primop InterlockedExchange_Addr "interlockedExchangeAddr#" GenPrimOp +primop InterlockedExchange_Addr "atomicExchangeAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) {The atomic exchange operation. Atomically exchanges the value at the first address with the Addr# given as second argument. Implies a read barrier.} with has_side_effects = True -primop InterlockedExchange_Int "interlockedExchangeInt#" GenPrimOp +primop InterlockedExchange_Int "atomicExchangeInt#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, Int# #) {The atomic exchange operation. Atomically exchanges the value at the address with the given value. Returns the old value. Implies a read barrier.} with has_side_effects = True +primop AtomicCompareExchange_Int "atomicCasInt#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> (# State# s, Int# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasInt# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + +primop AtomicCompareExchange_Addr "atomicCasAddr#" GenPrimOp + Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + { Compare and swap on a word-sized memory location. + + Use as atomicCasAddr# location expected desired + + This version always returns the old value read. This follows the normal protocol for CAS operations (and matches the underlying instruction on most architectures). + + Implies a full memory barrier.} + with has_side_effects = True + ------------------------------------------------------------------------ section "Mutable variables" {Operations on MutVar\#s.} ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2561,6 +2561,8 @@ genCCall' config is32Bit (PrimTarget (MO_Xchg width)) [dst] [addr, value] _ -- Copy the value into the target register, perform the exchange. let code = toOL [ MOV format (OpReg newval) (OpReg dst_r) + -- On X86 xchg implies a lock prefix if we use a memory argument. + -- so this is atomic. , XCHG format (OpAddr amode) dst_r ] return $ addr_code `appOL` newval_code `appOL` code ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -850,6 +850,10 @@ emitPrimOp dflags primop = case primop of emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] InterlockedExchange_Int -> \[src, value] -> opIntoRegs $ \[res] -> emitPrimCall [res] (MO_Xchg (wordWidth platform)) [src, value] + AtomicCompareExchange_Int -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] + AtomicCompareExchange_Addr -> \[dst, expected, new] -> opIntoRegs $ \[res] -> + emitPrimCall [res] (MO_Cmpxchg (wordWidth platform)) [dst, expected, new] -- SIMD primops (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do ===================================== libraries/base/GHC/Event/Internal.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE Unsafe #-} {-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} module GHC.Event.Internal ( @@ -13,6 +15,9 @@ module GHC.Event.Internal , module GHC.Event.Internal.Types -- * Helpers , throwErrnoIfMinus1NoRetry + + -- Atomic ptr exchange for WinIO + , exchangePtr ) where import Foreign.C.Error (eINTR, getErrno, throwErrno) @@ -21,6 +26,8 @@ import GHC.Base import GHC.Num (Num(..)) import GHC.Event.Internal.Types +import GHC.Ptr (Ptr(..)) + -- | Event notification backend. data Backend = forall a. Backend { _beState :: !a @@ -95,3 +102,12 @@ throwErrnoIfMinus1NoRetry loc f = do err <- getErrno if err == eINTR then return 0 else throwErrno loc else return res + +{-# INLINE exchangePtr #-} +-- | @exchangePtr pptr x@ swaps the pointer pointed to by @pptr@ with the value +-- @x@, returning the old value. +exchangePtr :: Ptr (Ptr a) -> Ptr a -> IO (Ptr a) +exchangePtr (Ptr dst) (Ptr val) = + IO $ \s -> + case (atomicExchangeAddr# dst val s) of + (# s2, old_val #) -> (# s2, Ptr old_val #) ===================================== libraries/base/GHC/Event/Windows.hsc ===================================== @@ -306,10 +306,6 @@ foreign import ccall safe "completeSynchronousRequest" cdOffset :: Int cdOffset = #{const __builtin_offsetof (HASKELL_OVERLAPPED, hoData)} --- | Terminator symbol for IOCP request -nullReq :: Ptr (Ptr a) -nullReq = castPtr $ unsafePerformIO $ new $ (nullPtr :: Ptr ()) - -- I don't expect a lot of events, so a simple linked lists should be enough. type EventElements = [(Event, HandleData)] data EventData = EventData { evtTopLevel :: !Event, evtElems :: !EventElements } @@ -667,7 +663,7 @@ withOverlappedEx mgr fname h offset startCB completionCB = do -- the pointer. debugIO $ "## Waiting for cancellation record... " _ <- FFI.getOverlappedResult h lpol True - oldDataPtr <- exchangePtr ptr_lpol nullReq + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr when (oldDataPtr == cdData) $ do reqs <- removeRequest debugIO $ "-1.. " ++ show reqs ++ " requests queued after error." @@ -1039,7 +1035,7 @@ processCompletion Manager{..} n delay = do ++ " offset: " ++ show cdOffset ++ " cdData: " ++ show cdDataCheck ++ " at idx " ++ show idx - oldDataPtr <- exchangePtr ptr_lpol nullReq :: IO (Ptr CompletionData) + oldDataPtr <- I.exchangePtr ptr_lpol nullPtr :: IO (Ptr CompletionData) debugIO $ ":: oldDataPtr " ++ show oldDataPtr when (oldDataPtr /= nullPtr) $ do debugIO $ "exchanged: " ++ show oldDataPtr ===================================== libraries/base/GHC/Ptr.hs ===================================== @@ -25,8 +25,6 @@ module GHC.Ptr ( -- * Unsafe functions castFunPtrToPtr, castPtrToFunPtr, - -- * Atomic operations - exchangePtr ) where import GHC.Base @@ -164,16 +162,6 @@ castFunPtrToPtr (FunPtr addr) = Ptr addr castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr ------------------------------------------------------------------------- --- Atomic operations for Ptr - -{-# INLINE exchangePtr #-} -exchangePtr :: Ptr (Ptr a) -> Ptr b -> IO (Ptr c) -exchangePtr (Ptr dst) (Ptr val) = - IO $ \s -> - case (interlockedExchangeAddr# dst val s) of - (# s2, old_val #) -> (# s2, Ptr old_val #) - ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -21,8 +21,8 @@ - Add primops for atomic exchange: - interlockedExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) - interlockedExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) + atomicExchangeAddr# :: Addr# -> Addr# -> State# s -> (# State# s, Addr# #) + atomicExchangeInt# :: Addr# -> Int# -> State# s -> (# State# s, Int# #) - Add an explicit fixity for `(~)` and `(~~)`: ===================================== testsuite/tests/codeGen/should_compile/cg011.hs ===================================== @@ -1,11 +1,11 @@ {-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} --- Tests compilation for interlockedExchange primop. +-- Tests compilation for atomic exchange primop. module M where -import GHC.Exts (interlockedExchangeInt#, Int#, Addr#, State# ) +import GHC.Exts (atomicExchangeInt#, Int#, Addr#, State# ) swap :: Addr# -> Int# -> State# s -> (# #) -swap ptr val s = case (interlockedExchangeInt# ptr val s) of +swap ptr val s = case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# #) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -90,6 +90,7 @@ test('cgrun077', [when(have_cpu_feature('bmi2'), extra_hc_opts('-mbmi2'))], comp test('cgrun078', omit_ways(['ghci']), compile_and_run, ['']) test('cgrun079', normal, compile_and_run, ['']) test('cgrun080', normal, compile_and_run, ['']) +test('cas_int', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/cas_int.hs ===================================== @@ -0,0 +1,54 @@ +{-# LANGUAGE CPP, MagicHash, BlockArguments, UnboxedTuples #-} +{-# LANGUAGE CPP, MagicHash, BlockArguments, ScopedTypeVariables #-} + +-- Test the atomic exchange primop. + +-- We initialize a value with 1, and then perform exchanges on it +-- with two different values. At the end all the values should still +-- be present. + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Control.Monad +import Control.Concurrent +import Foreign.Marshal.Alloc +import Foreign.Storable +import Data.List (sort) + +import GHC.Exts +import GHC.Types +import GHC.Ptr + +#include "MachDeps.h" + +main = do + alloca $ \(ptr_p :: Ptr (Ptr Int)) -> do + alloca $ \(ptr_i :: Ptr Int) -> do + alloca $ \(ptr_j :: Ptr Int) -> do + poke ptr_i (1 :: Int) + poke ptr_j (2 :: Int) + + --expected to swap + res_i <- cas ptr_i 1 3 :: IO Int + -- expected to fail + res_j <- cas ptr_j 1 4 :: IO Int + + putStrLn "Returned results:" + --(1,2) + print (res_i, res_j) + + i <-peek ptr_i + j <-peek ptr_j + + putStrLn "Stored results:" + --(3,2) + print (i,j) + +cas :: Ptr Int -> Int -> Int -> IO Int +cas (Ptr ptr) (I# expected) (I# desired)= do + IO $ \s -> case (atomicCasInt# ptr expected desired s) of + (# s2, old_val #) -> (# s2, I# old_val #) ===================================== testsuite/tests/codeGen/should_run/cas_int.stdout ===================================== @@ -0,0 +1,4 @@ +Returned results: +(1,2) +Stored results: +(3,2) ===================================== testsuite/tests/codeGen/should_run/cgrun080.hs ===================================== @@ -46,6 +46,6 @@ swapN n val ptr = do swap :: Ptr Int -> Int -> IO Int swap (Ptr ptr) (I# val) = do - IO $ \s -> case (interlockedExchangeInt# ptr val s) of + IO $ \s -> case (atomicExchangeInt# ptr val s) of (# s2, old_val #) -> (# s2, I# old_val #) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e00d92626b76b5f10d15832d1ca60527281753e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e00d92626b76b5f10d15832d1ca60527281753e You're receiving 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 30 10:45:51 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 06:45:51 -0400 Subject: [Git][ghc/ghc][wip/T18765] s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) Message-ID: <5f7461dfdf03c_80b3f8459789ef8155866b5@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18765 at Glasgow Haskell Compiler / GHC Commits: 9b3c12b5 by Sebastian Graf at 2020-09-30T12:44:54+02:00 s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) This defeats constant-folding in the final phases of the Simplifier, but enables us to get rid of allocations by inlining calls that can't be constant-folded. `NOINLINE[0]` is a better choice than `NOINLINE`, because 1. We still delay inlining long enough for the constant-folding RULEs to fire 2. The compiler has the option to inlining them late, possibly cancelling away boxes in the process. `NOINLINE[0]` is a better choice than `INLINE[0]`, because 3. We don't unconditionally inline huge definitions such as `integerDiv`, which would lead to code bloat at pretty much no gain. 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. `integerDiv`, there is no gain in inlining the unoptimised unfoldings. We also have to mark all callers that want to participate in constant folding as `INLINE`. See the new `Note [Integer constant folding]` for details. Fixes #18765. - - - - - 4 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Real.hs - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1347,7 +1347,7 @@ builtinBignumRules _ = , rule_shift_op "integerShiftL" integerShiftLName shiftL , rule_shift_op "integerShiftR" integerShiftRName shiftR , rule_integerBit "integerBit" integerBitName - -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs + -- See Note [Integer constant folding] in libraries/base/GHC/Num/Integer.hs , rule_divop_one "integerQuot" integerQuotName quot , rule_divop_one "integerRem" integerRemName rem , rule_divop_one "integerDiv" integerDivName div ===================================== libraries/base/GHC/Float.hs ===================================== @@ -494,6 +494,7 @@ instance Num Double where -- | @since 2.01 instance Real Double where + {-# INLINE toRational #-} -- See Note [Integer constant folding] toRational (D# x#) = case integerDecodeDouble# x# of (# m, e# #) @@ -580,11 +581,7 @@ instance Floating Double where -- | @since 2.01 instance RealFrac Double where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} - + {-# INLINE properFraction #-} -- See Note [Integer constant folding] properFraction x = case (decodeFloat x) of { (m,n) -> if n >= 0 then @@ -595,9 +592,11 @@ instance RealFrac Double where } } + {-# INLINE truncate #-} -- See Note [Integer constant folding] truncate x = case properFraction x of (n,_) -> n + {-# INLINE round #-} -- See Note [Integer constant folding] round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 @@ -608,9 +607,11 @@ instance RealFrac Double where EQ -> if even n then n else m GT -> m + {-# INLINE ceiling #-} -- See Note [Integer constant folding] ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n + {-# INLINE floor #-} -- See Note [Integer constant folding] floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n @@ -620,18 +621,23 @@ instance RealFloat Double where floatDigits _ = DBL_MANT_DIG -- ditto floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto + {-# INLINE decodeFloat #-} -- See Note [Integer constant folding] decodeFloat (D# x#) = case integerDecodeDouble# x# of (# i, j #) -> (i, I# j) + {-# INLINE encodeFloat #-} -- See Note [Integer constant folding] encodeFloat i (I# j) = D# (integerEncodeDouble# i j) + {-# INLINE exponent #-} -- See Note [Integer constant folding] exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x + {-# INLINE significand #-} -- See Note [Integer constant folding] significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) + {-# INLINE scaleFloat #-} -- See Note [Integer constant folding] scaleFloat 0 x = x scaleFloat k x | isFix = x ===================================== libraries/base/GHC/Real.hs ===================================== @@ -413,43 +413,31 @@ instance Real Integer where instance Real Natural where toRational n = integerFromNatural n :% 1 --- Note [Integer division constant folding] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Constant folding of quot, rem, div, mod, divMod and quotRem for Integer --- arguments depends crucially on inlining. Constant folding rules defined in --- GHC.Core.Opt.ConstantFold trigger for integerQuot, integerRem and so on. --- So if calls to quot, rem and so on were not inlined the rules would not fire. --- --- The rules would also not fire if calls to integerQuot and so on were inlined, --- but this does not happen because they are all marked with NOINLINE pragma. - - -- | @since 2.0.1 instance Integral Integer where toInteger n = n - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `integerQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `integerRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `integerDiv` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `integerMod` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `integerDivMod` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `integerQuotRem` d @@ -457,27 +445,27 @@ instance Integral Integer where instance Integral Natural where toInteger = integerFromNatural - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `naturalQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `naturalRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `naturalQuot` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `naturalRem` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `naturalQuotRem` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `naturalQuotRem` d ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -66,6 +66,7 @@ integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND -- | Check Integer invariants integerCheck :: Integer -> Bool +{-# INLINE integerCheck #-} integerCheck i = isTrue# (integerCheck# i) -- | Integer Zero @@ -145,18 +146,19 @@ integerFromInt (I# i) = IS i -- | Truncates 'Integer' to least-significant 'Int#' integerToInt# :: Integer -> Int# -{-# NOINLINE integerToInt# #-} +{-# NOINLINE[0] integerToInt# #-} -- See Note [Integer constant folding] integerToInt# (IS i) = i integerToInt# (IP b) = word2Int# (bigNatToWord# b) integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) -- | Truncates 'Integer' to least-significant 'Int#' integerToInt :: Integer -> Int +{-# INLINE integerToInt #-} -- See Note [Integer constant folding] integerToInt i = I# (integerToInt# i) -- | Convert a Word# into an Integer integerFromWord# :: Word# -> Integer -{-# NOINLINE integerFromWord# #-} +{-# NOINLINE[0] integerFromWord# #-} -- See Note [Integer constant folding] integerFromWord# w | i <- word2Int# w , isTrue# (i >=# 0#) @@ -167,6 +169,7 @@ integerFromWord# w -- | Convert a Word into an Integer integerFromWord :: Word -> Integer +{-# INLINE integerFromWord #-} -- See Note [Integer constant folding] integerFromWord (W# w) = integerFromWord# w -- | Create a negative Integer with the given Word magnitude @@ -185,23 +188,25 @@ integerFromWordSign# _ w = integerFromWordNeg# w -- | Truncate an Integer into a Word integerToWord# :: Integer -> Word# -{-# NOINLINE integerToWord# #-} +{-# NOINLINE[0] integerToWord# #-} -- See Note [Integer constant folding] integerToWord# (IS i) = int2Word# i integerToWord# (IP bn) = bigNatToWord# bn integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) -- | Truncate an Integer into a Word integerToWord :: Integer -> Word +{-# INLINE integerToWord #-} -- See Note [Integer constant folding] integerToWord !i = W# (integerToWord# i) -- | Convert a Natural into an Integer integerFromNatural :: Natural -> Integer -{-# NOINLINE integerFromNatural #-} +{-# NOINLINE[0] integerFromNatural #-} -- See Note [Integer constant folding] integerFromNatural (NS x) = integerFromWord# x integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer +{-# INLINE integerFromWordList #-} -- See Note [Integer constant folding] integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) @@ -209,7 +214,7 @@ integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- -- Return 0 for negative Integers. integerToNaturalClamp :: Integer -> Natural -{-# NOINLINE integerToNaturalClamp #-} +{-# NOINLINE[0] integerToNaturalClamp #-} -- See Note [Integer constant folding] integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) @@ -220,7 +225,7 @@ integerToNaturalClamp (IN _) = naturalZero -- -- Return absolute value integerToNatural :: Integer -> Natural -{-# NOINLINE integerToNatural #-} +{-# NOINLINE[0] integerToNatural #-} -- See Note [Integer constant folding] integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x @@ -237,40 +242,48 @@ integerIsNegative# (IN _) = 1# -- | Negative predicate integerIsNegative :: Integer -> Bool +{-# INLINE integerIsNegative #-} -- See Note [Integer constant folding] integerIsNegative !i = isTrue# (integerIsNegative# i) -- | Zero predicate integerIsZero :: Integer -> Bool +{-# INLINE integerIsZero #-} -- See Note [Integer constant folding] integerIsZero (IS 0#) = True integerIsZero _ = False -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool +{-# INLINE integerNe #-} -- See Note [Integer constant folding] integerNe !x !y = isTrue# (integerNe# x y) -- | Equal predicate. integerEq :: Integer -> Integer -> Bool +{-# INLINE integerEq #-} -- See Note [Integer constant folding] integerEq !x !y = isTrue# (integerEq# x y) -- | Lower-or-equal predicate. integerLe :: Integer -> Integer -> Bool +{-# INLINE integerLe #-} -- See Note [Integer constant folding] integerLe !x !y = isTrue# (integerLe# x y) -- | Lower predicate. integerLt :: Integer -> Integer -> Bool +{-# INLINE integerLt #-} -- See Note [Integer constant folding] integerLt !x !y = isTrue# (integerLt# x y) -- | Greater predicate. integerGt :: Integer -> Integer -> Bool +{-# INLINE integerGt #-} -- See Note [Integer constant folding] integerGt !x !y = isTrue# (integerGt# x y) -- | Greater-or-equal predicate. integerGe :: Integer -> Integer -> Bool +{-# INLINE integerGe #-} -- See Note [Integer constant folding] integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} +{-# NOINLINE[0] integerEq# #-} -- See Note [Integer constant folding] integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -278,7 +291,7 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} +{-# NOINLINE[0] integerNe# #-} -- See Note [Integer constant folding] integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -286,39 +299,41 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} +{-# NOINLINE[0] integerGt# #-} -- See Note [Integer constant folding] integerGt# (IS x) (IS y) = x ># y integerGt# x y | GT <- integerCompare x y = 1# integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} +{-# NOINLINE[0] integerLe# #-} -- See Note [Integer constant folding] integerLe# (IS x) (IS y) = x <=# y integerLe# x y | GT <- integerCompare x y = 0# integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} +{-# NOINLINE[0] integerLt# #-} -- See Note [Integer constant folding] integerLt# (IS x) (IS y) = x <# y integerLt# x y | LT <- integerCompare x y = 1# integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} +{-# NOINLINE[0] integerGe# #-} -- See Note [Integer constant folding] integerGe# (IS x) (IS y) = x >=# y integerGe# x y | LT <- integerCompare x y = 0# integerGe# _ _ = 1# instance Eq Integer where + {-# INLINE (==) #-} -- See Note [Integer constant folding] (==) = integerEq + {-# INLINE (/=) #-} -- See Note [Integer constant folding] (/=) = integerNe -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} +{-# NOINLINE[0] integerCompare #-} -- See Note [Integer constant folding] integerCompare (IS x) (IS y) = compareInt# x y integerCompare (IP x) (IP y) = bigNatCompare x y integerCompare (IN x) (IN y) = bigNatCompare y x @@ -330,6 +345,7 @@ integerCompare (IP _) (IN _) = GT integerCompare (IN _) (IP _) = LT instance Ord Integer where + {-# INLINE compare #-} -- See Note [Integer constant folding] compare = integerCompare --------------------------------------------------------------------- @@ -338,7 +354,7 @@ instance Ord Integer where -- | Subtract one 'Integer' from another. integerSub :: Integer -> Integer -> Integer -{-# NOINLINE integerSub #-} +{-# NOINLINE[0] integerSub #-} -- See Note [Integer constant folding] integerSub !x (IS 0#) = x integerSub (IS x#) (IS y#) = case subIntC# x# y# of @@ -384,7 +400,7 @@ integerSub (IN x) (IS y#) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer -{-# NOINLINE integerAdd #-} +{-# NOINLINE[0] integerAdd #-} -- See Note [Integer constant folding] integerAdd !x (IS 0#) = x integerAdd (IS 0#) y = y integerAdd (IS x#) (IS y#) @@ -413,7 +429,7 @@ integerAdd (IP x) (IN y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer -{-# NOINLINE integerMul #-} +{-# NOINLINE[0] integerMul #-} -- See Note [Integer constant folding] integerMul !_ (IS 0#) = IS 0# integerMul (IS 0#) _ = IS 0# integerMul x (IS 1#) = x @@ -478,7 +494,7 @@ integerMul (IN x) (IS y) -- IP is used iff n > maxBound::Int -- IN is used iff n < minBound::Int integerNegate :: Integer -> Integer -{-# NOINLINE integerNegate #-} +{-# NOINLINE[0] integerNegate #-} -- See Note [Integer constant folding] integerNegate (IN b) = IP b integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) integerNegate (IS i) = IS (negateInt# i) @@ -489,7 +505,7 @@ integerNegate (IP b) -- | Compute absolute value of an 'Integer' integerAbs :: Integer -> Integer -{-# NOINLINE integerAbs #-} +{-# NOINLINE[0] integerAbs #-} -- See Note [Integer constant folding] integerAbs (IN i) = IP i integerAbs n@(IP _) = n integerAbs n@(IS i) @@ -501,13 +517,13 @@ integerAbs n@(IS i) -- | Return @-1@, @0@, and @1@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum :: Integer -> Integer -{-# NOINLINE integerSignum #-} +{-# NOINLINE[0] integerSignum #-} -- See Note [Integer constant folding] integerSignum !j = IS (integerSignum# j) -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum# :: Integer -> Int# -{-# NOINLINE integerSignum# #-} +{-# NOINLINE[0] integerSignum# #-} -- See Note [Integer constant folding] integerSignum# (IN _) = -1# integerSignum# (IS i#) = sgnI# i# integerSignum# (IP _ ) = 1# @@ -515,7 +531,7 @@ integerSignum# (IP _ ) = 1# -- | Count number of set bits. For negative arguments returns -- the negated population count of the absolute value. integerPopCount# :: Integer -> Int# -{-# NOINLINE integerPopCount# #-} +{-# NOINLINE[0] integerPopCount# #-} -- See Note [Integer constant folding] integerPopCount# (IS i) | isTrue# (i >=# 0#) = word2Int# (popCntI# i) | True = negateInt# (word2Int# (popCntI# (negateInt# i))) @@ -524,7 +540,7 @@ integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) -- | Positive 'Integer' for which only /n/-th bit is set integerBit# :: Word# -> Integer -{-# NOINLINE integerBit# #-} +{-# NOINLINE[0] integerBit# #-} -- See Note [Integer constant folding] integerBit# i | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) = IS (uncheckedIShiftL# 1# (word2Int# i)) @@ -533,13 +549,14 @@ integerBit# i -- | 'Integer' for which only /n/-th bit is set integerBit :: Word -> Integer +{-# INLINE integerBit #-} -- See Note [Integer constant folding] integerBit (W# i) = integerBit# i -- | Test if /n/-th bit is set. -- -- Fake 2's complement for negative values (might be slow) integerTestBit# :: Integer -> Word# -> Bool# -{-# NOINLINE integerTestBit# #-} +{-# NOINLINE[0] integerTestBit# #-} -- See Note [Integer constant folding] integerTestBit# (IS x) i | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = testBitI# x i @@ -569,13 +586,14 @@ integerTestBit# (IN x) i -- -- Fake 2's complement for negative values (might be slow) integerTestBit :: Integer -> Word -> Bool +{-# INLINE integerTestBit #-} -- See Note [Integer constant folding] integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) -- | Shift-right operation -- -- Fake 2's complement for negative values (might be slow) integerShiftR# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftR# #-} +{-# NOINLINE[0] integerShiftR# #-} -- See Note [Integer constant folding] integerShiftR# !x 0## = x integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) where @@ -592,11 +610,12 @@ integerShiftR# (IN bn) n = -- -- Fake 2's complement for negative values (might be slow) integerShiftR :: Integer -> Word -> Integer +{-# INLINE integerShiftR #-} -- See Note [Integer constant folding] integerShiftR !x (W# w) = integerShiftR# x w -- | Shift-left operation integerShiftL# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftL# #-} +{-# NOINLINE[0] integerShiftL# #-} -- See Note [Integer constant folding] integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n @@ -611,13 +630,14 @@ integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) -- Remember that bits are stored in sign-magnitude form, hence the behavior of -- negative Integers is different from negative Int's behavior. integerShiftL :: Integer -> Word -> Integer +{-# INLINE integerShiftL #-} -- See Note [Integer constant folding] integerShiftL !x (W# w) = integerShiftL# x w -- | Bitwise OR operation -- -- Fake 2's complement for negative values (might be slow) integerOr :: Integer -> Integer -> Integer -{-# NOINLINE integerOr #-} +{-# NOINLINE[0] integerOr #-} -- See Note [Integer constant folding] integerOr a b = case a of IS 0# -> b IS -1# -> IS -1# @@ -676,7 +696,7 @@ integerOr a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerXor :: Integer -> Integer -> Integer -{-# NOINLINE integerXor #-} +{-# NOINLINE[0] integerXor #-} -- See Note [Integer constant folding] integerXor a b = case a of IS 0# -> b IS -1# -> integerComplement b @@ -731,7 +751,7 @@ integerXor a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerAnd :: Integer -> Integer -> Integer -{-# NOINLINE integerAnd #-} +{-# NOINLINE[0] integerAnd #-} -- See Note [Integer constant folding] integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> b @@ -766,7 +786,7 @@ integerAnd a b = case a of -- | Binary complement of the integerComplement :: Integer -> Integer -{-# NOINLINE integerComplement #-} +{-# NOINLINE[0] integerComplement #-} -- See Note [Integer constant folding] integerComplement (IS x) = IS (notI# x) integerComplement (IP x) = IN (bigNatAddWord# x 1##) integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) @@ -777,7 +797,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerQuotRem# #-} +{-# NOINLINE[0] integerQuotRem# #-} -- See Note [Integer constant folding] integerQuotRem# !n (IS 1#) = (# n, IS 0# #) integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) integerQuotRem# !_ (IS 0#) = case raiseDivZero of @@ -815,12 +835,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerQuotRem #-} -- See Note [Integer constant folding] integerQuotRem !x !y = case integerQuotRem# x y of (# q, r #) -> (q, r) integerQuot :: Integer -> Integer -> Integer -{-# NOINLINE integerQuot #-} +{-# NOINLINE[0] integerQuot #-} -- See Note [Integer constant folding] integerQuot !n (IS 1#) = n integerQuot !n (IS -1#) = integerNegate n integerQuot !_ (IS 0#) = raiseDivZero @@ -841,7 +862,7 @@ integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer -{-# NOINLINE integerRem #-} +{-# NOINLINE[0] integerRem #-} -- See Note [Integer constant folding] integerRem !_ (IS 1#) = IS 0# integerRem _ (IS -1#) = IS 0# integerRem _ (IS 0#) = IS (remInt# 0# 0#) @@ -863,7 +884,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerDivMod# #-} +{-# NOINLINE[0] integerDivMod# #-} -- See Note [Integer constant folding] integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) = let !q' = integerSub q (IS 1#) @@ -878,12 +899,13 @@ integerDivMod# !n !d -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerDivMod #-} -- See Note [Integer constant folding] integerDivMod !n !d = case integerDivMod# n d of (# q,r #) -> (q,r) integerDiv :: Integer -> Integer -> Integer -{-# NOINLINE integerDiv #-} +{-# NOINLINE[0] integerDiv #-} -- See Note [Integer constant folding] integerDiv !n !d -- same-sign ops can be handled by more efficient 'integerQuot' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d @@ -891,7 +913,7 @@ integerDiv !n !d integerMod :: Integer -> Integer -> Integer -{-# NOINLINE integerMod #-} +{-# NOINLINE[0] integerMod #-} -- See Note [Integer constant folding] integerMod !n !d -- same-sign ops can be handled by more efficient 'integerRem' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d @@ -899,7 +921,7 @@ integerMod !n !d -- | Compute greatest common divisor. integerGcd :: Integer -> Integer -> Integer -{-# NOINLINE integerGcd #-} +{-# NOINLINE[0] integerGcd #-} -- See Note [Integer constant folding] integerGcd (IS 0#) !b = integerAbs b integerGcd a (IS 0#) = integerAbs a integerGcd (IS 1#) _ = IS 1# @@ -917,7 +939,7 @@ integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (ab -- | Compute least common multiple. integerLcm :: Integer -> Integer -> Integer -{-# NOINLINE integerLcm #-} +{-# NOINLINE[0] integerLcm #-} -- See Note [Integer constant folding] integerLcm (IS 0#) !_ = IS 0# integerLcm (IS 1#) b = integerAbs b integerLcm (IS -1#) b = integerAbs b @@ -931,6 +953,7 @@ integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab -- | Square a Integer integerSqr :: Integer -> Integer +{-# INLINE integerSqr #-} -- See Note [Integer constant folding] integerSqr !a = integerMul a a @@ -948,6 +971,7 @@ integerLog2# (IP b) = bigNatLog2# b -- -- For numbers <= 0, return 0 integerLog2 :: Integer -> Word +{-# INLINE integerLog2 #-} -- See Note [Integer constant folding] integerLog2 !i = W# (integerLog2# i) -- | Logarithm (floor) for an arbitrary base @@ -962,6 +986,7 @@ integerLogBaseWord# base !i -- -- For numbers <= 0, return 0 integerLogBaseWord :: Word -> Integer -> Word +{-# INLINE integerLogBaseWord #-} -- See Note [Integer constant folding] integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) -- | Logarithm (floor) for an arbitrary base @@ -977,6 +1002,7 @@ integerLogBase# !base !i -- -- For numbers <= 0, return 0 integerLogBase :: Integer -> Integer -> Word +{-# INLINE integerLogBase #-} -- See Note [Integer constant folding] integerLogBase !base !i = W# (integerLogBase# base i) -- | Indicate if the value is a power of two and which one @@ -991,7 +1017,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer on 32-bit architectures integerFromInt64# :: Int64# -> Integer -{-# NOINLINE integerFromInt64# #-} +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !i | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) &&# (i `geInt64#` intToInt64# -0x80000000#)) @@ -1005,7 +1031,7 @@ integerFromInt64# !i -- | Convert a Word64# into an Integer on 32-bit architectures integerFromWord64# :: Word64# -> Integer -{-# NOINLINE integerFromWord64# #-} +{-# NOINLINE[0] integerFromWord64# #-} -- See Note [Integer constant folding] integerFromWord64# !w | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) = IS (int64ToInt# (word64ToInt64# w)) @@ -1014,14 +1040,14 @@ integerFromWord64# !w -- | Convert an Integer into an Int64# on 32-bit architectures integerToInt64# :: Integer -> Int64# -{-# NOINLINE integerToInt64# #-} +{-# NOINLINE[0] integerToInt64# #-} -- See Note [Integer constant folding] integerToInt64# (IS i) = intToInt64# i integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) -- | Convert an Integer into a Word64# on 32-bit architectures integerToWord64# :: Integer -> Word64# -{-# NOINLINE integerToWord64# #-} +{-# NOINLINE[0] integerToWord64# #-} -- See Note [Integer constant folding] integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) integerToWord64# (IP b) = bigNatToWord64# b integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) @@ -1040,18 +1066,19 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# NOINLINE[0] integerDecodeDouble# #-} -- See Note [Integer constant folding] integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble :: Double -> (Integer, Int) +{-# INLINE integerDecodeDouble #-} -- See Note [Integer constant folding] integerDecodeDouble (D# x) = case integerDecodeDouble# x of (# m, e #) -> (m, I# e) -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# -{-# NOINLINE integerEncodeDouble# #-} +{-# NOINLINE[0] integerEncodeDouble# #-} -- See Note [Integer constant folding] integerEncodeDouble# (IS i) 0# = int2Double# i integerEncodeDouble# (IS i) e = intEncodeDouble# i e integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e @@ -1059,23 +1086,24 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) -- | Encode (Integer mantissa, Int exponent) into a Double integerEncodeDouble :: Integer -> Int -> Double +{-# INLINE integerEncodeDouble #-} -- See Note [Integer constant folding] integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) -- | Encode an Integer (mantissa) into a Double# integerToDouble# :: Integer -> Double# -{-# NOINLINE integerToDouble# #-} +{-# NOINLINE[0] integerToDouble# #-} -- See Note [Integer constant folding] integerToDouble# !i = integerEncodeDouble# i 0# -- | Encode an Integer (mantissa) into a Float# integerToFloat# :: Integer -> Float# -{-# NOINLINE integerToFloat# #-} +{-# NOINLINE[0] integerToFloat# #-} -- See Note [Integer constant folding] integerToFloat# !i = integerEncodeFloat# i 0# -- | Encode (# Integer mantissa, Int# exponent #) into a Float# -- -- TODO: Not sure if it's worth to write 'Float' optimized versions here integerEncodeFloat# :: Integer -> Int# -> Float# -{-# NOINLINE integerEncodeFloat# #-} +{-# NOINLINE[0] integerEncodeFloat# #-} -- See Note [Integer constant folding] integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) @@ -1105,6 +1133,7 @@ integerToAddr# (IN n) = bigNatToAddr# n -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +{-# INLINE integerToAddr #-} -- See Note [Integer constant folding] integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1132,6 +1161,7 @@ integerFromAddr# sz addr e s = -- -- Null higher limbs are automatically trimed. integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +{-# INLINE integerFromAddr #-} -- See Note [Integer constant folding] integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) @@ -1154,6 +1184,7 @@ integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +{-# INLINE integerToMutableByteArray #-} -- See Note [Integer constant folding] integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of (# s', r #) -> (# s', W# r #) @@ -1180,6 +1211,7 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of -- -- Null higher limbs are automatically trimed. integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +{-# INLINE integerFromByteArray #-} -- See Note [Integer constant folding] integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i @@ -1212,5 +1244,36 @@ integerGcde :: Integer -> Integer -> ( Integer, Integer, Integer) +{-# INLINE integerGcde #-} -- See Note [Integer constant folding] integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) + +{- Note [Integer constant folding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We define constant folding rules in "GHC.Core.Opt.ConstantFold" for most of the + at integer*#@ operations in this module, hence they are marked NOINLINE[0]. + +Why NOINLINE[0] rather than NOINLINE? Because + + 1. We still delay inlining long enough for the constant-folding RULEs + to fire + 2. The compiler has the option to inlining the operations late, possibly + cancelling away boxes in the process. + +Why NOINLINE[0] rather than INLINE? Because + + 3. We don't unconditionally inline huge definitions such as + `integerDiv`, which would lead to code bloat at pretty much no + gain. + 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. + `integerDiv`, there is no gain in inlining the unoptimised + unfoldings. + +But since we potentially inline the constant folded operations in phase 0, we +have to make sure that *all* callers that want to take part in constant folding +are marked INLINE. Otherwise, we'd store optimised unfoldings for them, in which +the constant folded functions are inlined. +That concerns for most of the @integer*@ without trailing hash in this module, +as well as the type class instances for 'Eq', 'Ord', 'Num', 'Integral', +'RealFloat' (which is for 'Double'!), etc. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b3c12b5351ce930085743c7ab7231acabf75f08 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b3c12b5351ce930085743c7ab7231acabf75f08 You're receiving 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 30 11:13:55 2020 From: gitlab at gitlab.haskell.org (Andreas Klebinger) Date: Wed, 30 Sep 2020 07:13:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/tune_perf_tests Message-ID: <5f7468739bfe2_80b3f8495b82d20155891c6@gitlab.haskell.org.mail> Andreas Klebinger pushed new branch wip/andreask/tune_perf_tests at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/tune_perf_tests You're receiving 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 30 12:35:16 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 08:35:16 -0400 Subject: [Git][ghc/ghc][wip/T18765] s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) Message-ID: <5f747b84f0559_80b3f841f3c57981560463@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18765 at Glasgow Haskell Compiler / GHC Commits: e415b4b3 by Sebastian Graf at 2020-09-30T14:33:49+02:00 s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) This defeats constant-folding in the final phases of the Simplifier, but enables us to get rid of allocations by inlining calls that can't be constant-folded. `NOINLINE[0]` is a better choice than `NOINLINE`, because 1. We still delay inlining long enough for the constant-folding RULEs to fire 2. The compiler has the option to inlining them late, possibly cancelling away boxes in the process. `NOINLINE[0]` is a better choice than `INLINE[0]`, because 3. We don't unconditionally inline huge definitions such as `integerDiv`, which would lead to code bloat at pretty much no gain. 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. `integerDiv`, there is no gain in inlining the unoptimised unfoldings. We also have to mark all callers that want to participate in constant folding as `INLINE`. See the new `Note [Integer constant folding]` for details. I had to change the `Num.fromInteger` and `Integral.toInteger` implementations of `Int*` and `Word*` variants to call the constant folded `integerToInt*#` and `integerToWord*#` variants directly to ensure constant folding. Fixes #18765. - - - - - 7 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/GHC/Word.hs - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1347,7 +1347,7 @@ builtinBignumRules _ = , rule_shift_op "integerShiftL" integerShiftLName shiftL , rule_shift_op "integerShiftR" integerShiftRName shiftR , rule_integerBit "integerBit" integerBitName - -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs + -- See Note [Integer constant folding] in "GHC.Num.Integer" , rule_divop_one "integerQuot" integerQuotName quot , rule_divop_one "integerRem" integerRemName rem , rule_divop_one "integerDiv" integerDivName div ===================================== libraries/base/GHC/Float.hs ===================================== @@ -494,6 +494,7 @@ instance Num Double where -- | @since 2.01 instance Real Double where + {-# INLINE toRational #-} -- See Note [Integer constant folding] toRational (D# x#) = case integerDecodeDouble# x# of (# m, e# #) @@ -580,11 +581,7 @@ instance Floating Double where -- | @since 2.01 instance RealFrac Double where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} - + {-# INLINE properFraction #-} -- See Note [Integer constant folding] properFraction x = case (decodeFloat x) of { (m,n) -> if n >= 0 then @@ -595,9 +592,11 @@ instance RealFrac Double where } } + {-# INLINE truncate #-} -- See Note [Integer constant folding] truncate x = case properFraction x of (n,_) -> n + {-# INLINE round #-} -- See Note [Integer constant folding] round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 @@ -608,9 +607,11 @@ instance RealFrac Double where EQ -> if even n then n else m GT -> m + {-# INLINE ceiling #-} -- See Note [Integer constant folding] ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n + {-# INLINE floor #-} -- See Note [Integer constant folding] floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n @@ -620,18 +621,23 @@ instance RealFloat Double where floatDigits _ = DBL_MANT_DIG -- ditto floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto + {-# INLINE decodeFloat #-} -- See Note [Integer constant folding] decodeFloat (D# x#) = case integerDecodeDouble# x# of (# i, j #) -> (i, I# j) + {-# INLINE encodeFloat #-} -- See Note [Integer constant folding] encodeFloat i (I# j) = D# (integerEncodeDouble# i j) + {-# INLINE exponent #-} -- See Note [Integer constant folding] exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x + {-# INLINE significand #-} -- See Note [Integer constant folding] significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) + {-# INLINE scaleFloat #-} -- See Note [Integer constant folding] scaleFloat 0 x = x scaleFloat k x | isFix = x ===================================== libraries/base/GHC/Int.hs ===================================== @@ -106,6 +106,7 @@ instance Num Int8 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I8# (narrow8Int# (integerToInt# i)) -- | @since 2.01 @@ -160,7 +161,8 @@ instance Integral Int8 where (# d, m #) -> (I8# (narrow8Int# d), I8# (narrow8Int# m)) - toInteger (I8# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I8# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int8 where @@ -313,6 +315,7 @@ instance Num Int16 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I16# (narrow16Int# (integerToInt# i)) -- | @since 2.01 @@ -367,7 +370,8 @@ instance Integral Int16 where (# d, m #) -> (I16# (narrow16Int# d), I16# (narrow16Int# m)) - toInteger (I16# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I16# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int16 where @@ -525,6 +529,7 @@ instance Num Int32 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I32# (narrow32Int# (integerToInt# i)) -- | @since 2.01 @@ -587,7 +592,8 @@ instance Integral Int32 where (# d, m #) -> (I32# (narrow32Int# d), I32# (narrow32Int# m)) - toInteger (I32# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I32# x) = integerFromInt64# x -- | @since 2.01 instance Read Int32 where @@ -748,6 +754,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt64# i) -- | @since 2.01 @@ -804,6 +811,7 @@ instance Integral Int64 where | y == (-1) && x == minBound = (overflowError, 0) | otherwise = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (I64# x) = integerFromInt64# x @@ -953,6 +961,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt# i) -- | @since 2.01 @@ -1006,7 +1015,8 @@ instance Integral Int64 where | otherwise = case x# `divModInt#` y# of (# d, m #) -> (I64# d, I64# m) - toInteger (I64# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I64# x) = integerFromInt64# x -- | @since 2.01 instance Read Int64 where ===================================== libraries/base/GHC/Num.hs ===================================== @@ -109,7 +109,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 - {-# INLINE fromInteger #-} -- Just to be sure! + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToInt i -- | @since 2.01 @@ -121,6 +121,7 @@ instance Num Word where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToWord i -- | @since 2.01 @@ -160,4 +161,3 @@ instance Num Natural where {-# DEPRECATED quotRemInteger "Use integerQuotRem# instead" #-} quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) quotRemInteger = integerQuotRem# - ===================================== libraries/base/GHC/Real.hs ===================================== @@ -324,7 +324,8 @@ instance Real Int where -- | @since 2.0.1 instance Integral Int where - toInteger (I# i) = IS i + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I# x) = integerFromInt# x a `quot` b | b == 0 = divZeroError @@ -399,6 +400,7 @@ instance Integral Word where divMod (W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W# x#) = integerFromWord# x# -------------------------------------------------------------- @@ -413,71 +415,60 @@ instance Real Integer where instance Real Natural where toRational n = integerFromNatural n :% 1 --- Note [Integer division constant folding] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Constant folding of quot, rem, div, mod, divMod and quotRem for Integer --- arguments depends crucially on inlining. Constant folding rules defined in --- GHC.Core.Opt.ConstantFold trigger for integerQuot, integerRem and so on. --- So if calls to quot, rem and so on were not inlined the rules would not fire. --- --- The rules would also not fire if calls to integerQuot and so on were inlined, --- but this does not happen because they are all marked with NOINLINE pragma. - - -- | @since 2.0.1 instance Integral Integer where toInteger n = n - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `integerQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `integerRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `integerDiv` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `integerMod` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `integerDivMod` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `integerQuotRem` d -- | @since 4.8.0.0 instance Integral Natural where + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger = integerFromNatural - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `naturalQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `naturalRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `naturalQuot` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `naturalRem` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `naturalQuotRem` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `naturalQuotRem` d ===================================== libraries/base/GHC/Word.hs ===================================== @@ -112,6 +112,7 @@ instance Num Word8 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W8# (narrow8Word# (integerToWord# i)) -- | @since 2.01 @@ -156,7 +157,8 @@ instance Integral Word8 where divMod (W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W8# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W8# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word8 where @@ -303,6 +305,7 @@ instance Num Word16 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W16# (narrow16Word# (integerToWord# i)) -- | @since 2.01 @@ -347,7 +350,8 @@ instance Integral Word16 where divMod (W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W16# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W16# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word16 where @@ -533,6 +537,7 @@ instance Num Word32 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W32# (narrow32Word# (integerToWord# i)) -- | @since 2.01 @@ -587,15 +592,8 @@ instance Integral Word32 where divMod (W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W32# x#) -#if WORD_SIZE_IN_BITS == 32 - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# -#else - = IS (word2Int# x#) -#endif + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W32# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word32 where @@ -728,6 +726,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord64# i) -- | @since 2.01 @@ -770,6 +769,7 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W64# x#) = integerFromWord64# x# -- | @since 2.01 @@ -875,6 +875,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord# i) -- | @since 2.01 @@ -953,11 +954,8 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W64# x#) - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W64# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word64 where ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -66,6 +66,7 @@ integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND -- | Check Integer invariants integerCheck :: Integer -> Bool +{-# INLINE integerCheck #-} integerCheck i = isTrue# (integerCheck# i) -- | Integer Zero @@ -137,6 +138,7 @@ integerToBigNatClamp# _ = bigNatZero# (# #) -- | Create an Integer from an Int# integerFromInt# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt# #-} -- See Note [Integer constant folding] integerFromInt# i = IS i -- | Create an Integer from an Int @@ -145,18 +147,19 @@ integerFromInt (I# i) = IS i -- | Truncates 'Integer' to least-significant 'Int#' integerToInt# :: Integer -> Int# -{-# NOINLINE integerToInt# #-} +{-# NOINLINE[0] integerToInt# #-} -- See Note [Integer constant folding] integerToInt# (IS i) = i integerToInt# (IP b) = word2Int# (bigNatToWord# b) integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) -- | Truncates 'Integer' to least-significant 'Int#' integerToInt :: Integer -> Int +{-# INLINE integerToInt #-} -- See Note [Integer constant folding] integerToInt i = I# (integerToInt# i) -- | Convert a Word# into an Integer integerFromWord# :: Word# -> Integer -{-# NOINLINE integerFromWord# #-} +{-# NOINLINE[0] integerFromWord# #-} -- See Note [Integer constant folding] integerFromWord# w | i <- word2Int# w , isTrue# (i >=# 0#) @@ -167,6 +170,7 @@ integerFromWord# w -- | Convert a Word into an Integer integerFromWord :: Word -> Integer +{-# INLINE integerFromWord #-} -- See Note [Integer constant folding] integerFromWord (W# w) = integerFromWord# w -- | Create a negative Integer with the given Word magnitude @@ -185,23 +189,25 @@ integerFromWordSign# _ w = integerFromWordNeg# w -- | Truncate an Integer into a Word integerToWord# :: Integer -> Word# -{-# NOINLINE integerToWord# #-} +{-# NOINLINE[0] integerToWord# #-} -- See Note [Integer constant folding] integerToWord# (IS i) = int2Word# i integerToWord# (IP bn) = bigNatToWord# bn integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) -- | Truncate an Integer into a Word integerToWord :: Integer -> Word +{-# INLINE integerToWord #-} -- See Note [Integer constant folding] integerToWord !i = W# (integerToWord# i) -- | Convert a Natural into an Integer integerFromNatural :: Natural -> Integer -{-# NOINLINE integerFromNatural #-} +{-# NOINLINE[0] integerFromNatural #-} -- See Note [Integer constant folding] integerFromNatural (NS x) = integerFromWord# x integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer +{-# INLINE integerFromWordList #-} -- See Note [Integer constant folding] integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) @@ -209,7 +215,7 @@ integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- -- Return 0 for negative Integers. integerToNaturalClamp :: Integer -> Natural -{-# NOINLINE integerToNaturalClamp #-} +{-# NOINLINE[0] integerToNaturalClamp #-} -- See Note [Integer constant folding] integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) @@ -220,7 +226,7 @@ integerToNaturalClamp (IN _) = naturalZero -- -- Return absolute value integerToNatural :: Integer -> Natural -{-# NOINLINE integerToNatural #-} +{-# NOINLINE[0] integerToNatural #-} -- See Note [Integer constant folding] integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x @@ -237,40 +243,48 @@ integerIsNegative# (IN _) = 1# -- | Negative predicate integerIsNegative :: Integer -> Bool +{-# INLINE integerIsNegative #-} -- See Note [Integer constant folding] integerIsNegative !i = isTrue# (integerIsNegative# i) -- | Zero predicate integerIsZero :: Integer -> Bool +{-# INLINE integerIsZero #-} -- See Note [Integer constant folding] integerIsZero (IS 0#) = True integerIsZero _ = False -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool +{-# INLINE integerNe #-} -- See Note [Integer constant folding] integerNe !x !y = isTrue# (integerNe# x y) -- | Equal predicate. integerEq :: Integer -> Integer -> Bool +{-# INLINE integerEq #-} -- See Note [Integer constant folding] integerEq !x !y = isTrue# (integerEq# x y) -- | Lower-or-equal predicate. integerLe :: Integer -> Integer -> Bool +{-# INLINE integerLe #-} -- See Note [Integer constant folding] integerLe !x !y = isTrue# (integerLe# x y) -- | Lower predicate. integerLt :: Integer -> Integer -> Bool +{-# INLINE integerLt #-} -- See Note [Integer constant folding] integerLt !x !y = isTrue# (integerLt# x y) -- | Greater predicate. integerGt :: Integer -> Integer -> Bool +{-# INLINE integerGt #-} -- See Note [Integer constant folding] integerGt !x !y = isTrue# (integerGt# x y) -- | Greater-or-equal predicate. integerGe :: Integer -> Integer -> Bool +{-# INLINE integerGe #-} -- See Note [Integer constant folding] integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} +{-# NOINLINE[0] integerEq# #-} -- See Note [Integer constant folding] integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -278,7 +292,7 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} +{-# NOINLINE[0] integerNe# #-} -- See Note [Integer constant folding] integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -286,39 +300,41 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} +{-# NOINLINE[0] integerGt# #-} -- See Note [Integer constant folding] integerGt# (IS x) (IS y) = x ># y integerGt# x y | GT <- integerCompare x y = 1# integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} +{-# NOINLINE[0] integerLe# #-} -- See Note [Integer constant folding] integerLe# (IS x) (IS y) = x <=# y integerLe# x y | GT <- integerCompare x y = 0# integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} +{-# NOINLINE[0] integerLt# #-} -- See Note [Integer constant folding] integerLt# (IS x) (IS y) = x <# y integerLt# x y | LT <- integerCompare x y = 1# integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} +{-# NOINLINE[0] integerGe# #-} -- See Note [Integer constant folding] integerGe# (IS x) (IS y) = x >=# y integerGe# x y | LT <- integerCompare x y = 0# integerGe# _ _ = 1# instance Eq Integer where + {-# INLINE (==) #-} -- See Note [Integer constant folding] (==) = integerEq + {-# INLINE (/=) #-} -- See Note [Integer constant folding] (/=) = integerNe -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} +{-# NOINLINE[0] integerCompare #-} -- See Note [Integer constant folding] integerCompare (IS x) (IS y) = compareInt# x y integerCompare (IP x) (IP y) = bigNatCompare x y integerCompare (IN x) (IN y) = bigNatCompare y x @@ -330,6 +346,7 @@ integerCompare (IP _) (IN _) = GT integerCompare (IN _) (IP _) = LT instance Ord Integer where + {-# INLINE compare #-} -- See Note [Integer constant folding] compare = integerCompare --------------------------------------------------------------------- @@ -338,7 +355,7 @@ instance Ord Integer where -- | Subtract one 'Integer' from another. integerSub :: Integer -> Integer -> Integer -{-# NOINLINE integerSub #-} +{-# NOINLINE[0] integerSub #-} -- See Note [Integer constant folding] integerSub !x (IS 0#) = x integerSub (IS x#) (IS y#) = case subIntC# x# y# of @@ -384,7 +401,7 @@ integerSub (IN x) (IS y#) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer -{-# NOINLINE integerAdd #-} +{-# NOINLINE[0] integerAdd #-} -- See Note [Integer constant folding] integerAdd !x (IS 0#) = x integerAdd (IS 0#) y = y integerAdd (IS x#) (IS y#) @@ -413,7 +430,7 @@ integerAdd (IP x) (IN y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer -{-# NOINLINE integerMul #-} +{-# NOINLINE[0] integerMul #-} -- See Note [Integer constant folding] integerMul !_ (IS 0#) = IS 0# integerMul (IS 0#) _ = IS 0# integerMul x (IS 1#) = x @@ -478,7 +495,7 @@ integerMul (IN x) (IS y) -- IP is used iff n > maxBound::Int -- IN is used iff n < minBound::Int integerNegate :: Integer -> Integer -{-# NOINLINE integerNegate #-} +{-# NOINLINE[0] integerNegate #-} -- See Note [Integer constant folding] integerNegate (IN b) = IP b integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) integerNegate (IS i) = IS (negateInt# i) @@ -489,7 +506,7 @@ integerNegate (IP b) -- | Compute absolute value of an 'Integer' integerAbs :: Integer -> Integer -{-# NOINLINE integerAbs #-} +{-# NOINLINE[0] integerAbs #-} -- See Note [Integer constant folding] integerAbs (IN i) = IP i integerAbs n@(IP _) = n integerAbs n@(IS i) @@ -501,13 +518,13 @@ integerAbs n@(IS i) -- | Return @-1@, @0@, and @1@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum :: Integer -> Integer -{-# NOINLINE integerSignum #-} +{-# NOINLINE[0] integerSignum #-} -- See Note [Integer constant folding] integerSignum !j = IS (integerSignum# j) -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum# :: Integer -> Int# -{-# NOINLINE integerSignum# #-} +{-# NOINLINE[0] integerSignum# #-} -- See Note [Integer constant folding] integerSignum# (IN _) = -1# integerSignum# (IS i#) = sgnI# i# integerSignum# (IP _ ) = 1# @@ -515,7 +532,7 @@ integerSignum# (IP _ ) = 1# -- | Count number of set bits. For negative arguments returns -- the negated population count of the absolute value. integerPopCount# :: Integer -> Int# -{-# NOINLINE integerPopCount# #-} +{-# NOINLINE[0] integerPopCount# #-} -- See Note [Integer constant folding] integerPopCount# (IS i) | isTrue# (i >=# 0#) = word2Int# (popCntI# i) | True = negateInt# (word2Int# (popCntI# (negateInt# i))) @@ -524,7 +541,7 @@ integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) -- | Positive 'Integer' for which only /n/-th bit is set integerBit# :: Word# -> Integer -{-# NOINLINE integerBit# #-} +{-# NOINLINE[0] integerBit# #-} -- See Note [Integer constant folding] integerBit# i | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) = IS (uncheckedIShiftL# 1# (word2Int# i)) @@ -533,13 +550,14 @@ integerBit# i -- | 'Integer' for which only /n/-th bit is set integerBit :: Word -> Integer +{-# INLINE integerBit #-} -- See Note [Integer constant folding] integerBit (W# i) = integerBit# i -- | Test if /n/-th bit is set. -- -- Fake 2's complement for negative values (might be slow) integerTestBit# :: Integer -> Word# -> Bool# -{-# NOINLINE integerTestBit# #-} +{-# NOINLINE[0] integerTestBit# #-} -- See Note [Integer constant folding] integerTestBit# (IS x) i | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = testBitI# x i @@ -569,13 +587,14 @@ integerTestBit# (IN x) i -- -- Fake 2's complement for negative values (might be slow) integerTestBit :: Integer -> Word -> Bool +{-# INLINE integerTestBit #-} -- See Note [Integer constant folding] integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) -- | Shift-right operation -- -- Fake 2's complement for negative values (might be slow) integerShiftR# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftR# #-} +{-# NOINLINE[0] integerShiftR# #-} -- See Note [Integer constant folding] integerShiftR# !x 0## = x integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) where @@ -592,11 +611,12 @@ integerShiftR# (IN bn) n = -- -- Fake 2's complement for negative values (might be slow) integerShiftR :: Integer -> Word -> Integer +{-# INLINE integerShiftR #-} -- See Note [Integer constant folding] integerShiftR !x (W# w) = integerShiftR# x w -- | Shift-left operation integerShiftL# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftL# #-} +{-# NOINLINE[0] integerShiftL# #-} -- See Note [Integer constant folding] integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n @@ -611,13 +631,14 @@ integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) -- Remember that bits are stored in sign-magnitude form, hence the behavior of -- negative Integers is different from negative Int's behavior. integerShiftL :: Integer -> Word -> Integer +{-# INLINE integerShiftL #-} -- See Note [Integer constant folding] integerShiftL !x (W# w) = integerShiftL# x w -- | Bitwise OR operation -- -- Fake 2's complement for negative values (might be slow) integerOr :: Integer -> Integer -> Integer -{-# NOINLINE integerOr #-} +{-# NOINLINE[0] integerOr #-} -- See Note [Integer constant folding] integerOr a b = case a of IS 0# -> b IS -1# -> IS -1# @@ -676,7 +697,7 @@ integerOr a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerXor :: Integer -> Integer -> Integer -{-# NOINLINE integerXor #-} +{-# NOINLINE[0] integerXor #-} -- See Note [Integer constant folding] integerXor a b = case a of IS 0# -> b IS -1# -> integerComplement b @@ -731,7 +752,7 @@ integerXor a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerAnd :: Integer -> Integer -> Integer -{-# NOINLINE integerAnd #-} +{-# NOINLINE[0] integerAnd #-} -- See Note [Integer constant folding] integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> b @@ -766,7 +787,7 @@ integerAnd a b = case a of -- | Binary complement of the integerComplement :: Integer -> Integer -{-# NOINLINE integerComplement #-} +{-# NOINLINE[0] integerComplement #-} -- See Note [Integer constant folding] integerComplement (IS x) = IS (notI# x) integerComplement (IP x) = IN (bigNatAddWord# x 1##) integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) @@ -777,7 +798,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerQuotRem# #-} +{-# NOINLINE[0] integerQuotRem# #-} -- See Note [Integer constant folding] integerQuotRem# !n (IS 1#) = (# n, IS 0# #) integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) integerQuotRem# !_ (IS 0#) = case raiseDivZero of @@ -815,12 +836,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerQuotRem #-} -- See Note [Integer constant folding] integerQuotRem !x !y = case integerQuotRem# x y of (# q, r #) -> (q, r) integerQuot :: Integer -> Integer -> Integer -{-# NOINLINE integerQuot #-} +{-# NOINLINE[0] integerQuot #-} -- See Note [Integer constant folding] integerQuot !n (IS 1#) = n integerQuot !n (IS -1#) = integerNegate n integerQuot !_ (IS 0#) = raiseDivZero @@ -841,7 +863,7 @@ integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer -{-# NOINLINE integerRem #-} +{-# NOINLINE[0] integerRem #-} -- See Note [Integer constant folding] integerRem !_ (IS 1#) = IS 0# integerRem _ (IS -1#) = IS 0# integerRem _ (IS 0#) = IS (remInt# 0# 0#) @@ -863,7 +885,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerDivMod# #-} +{-# NOINLINE[0] integerDivMod# #-} -- See Note [Integer constant folding] integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) = let !q' = integerSub q (IS 1#) @@ -878,12 +900,13 @@ integerDivMod# !n !d -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerDivMod #-} -- See Note [Integer constant folding] integerDivMod !n !d = case integerDivMod# n d of (# q,r #) -> (q,r) integerDiv :: Integer -> Integer -> Integer -{-# NOINLINE integerDiv #-} +{-# NOINLINE[0] integerDiv #-} -- See Note [Integer constant folding] integerDiv !n !d -- same-sign ops can be handled by more efficient 'integerQuot' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d @@ -891,7 +914,7 @@ integerDiv !n !d integerMod :: Integer -> Integer -> Integer -{-# NOINLINE integerMod #-} +{-# NOINLINE[0] integerMod #-} -- See Note [Integer constant folding] integerMod !n !d -- same-sign ops can be handled by more efficient 'integerRem' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d @@ -899,7 +922,7 @@ integerMod !n !d -- | Compute greatest common divisor. integerGcd :: Integer -> Integer -> Integer -{-# NOINLINE integerGcd #-} +{-# NOINLINE[0] integerGcd #-} -- See Note [Integer constant folding] integerGcd (IS 0#) !b = integerAbs b integerGcd a (IS 0#) = integerAbs a integerGcd (IS 1#) _ = IS 1# @@ -917,7 +940,7 @@ integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (ab -- | Compute least common multiple. integerLcm :: Integer -> Integer -> Integer -{-# NOINLINE integerLcm #-} +{-# NOINLINE[0] integerLcm #-} -- See Note [Integer constant folding] integerLcm (IS 0#) !_ = IS 0# integerLcm (IS 1#) b = integerAbs b integerLcm (IS -1#) b = integerAbs b @@ -931,6 +954,7 @@ integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab -- | Square a Integer integerSqr :: Integer -> Integer +{-# INLINE integerSqr #-} -- See Note [Integer constant folding] integerSqr !a = integerMul a a @@ -948,6 +972,7 @@ integerLog2# (IP b) = bigNatLog2# b -- -- For numbers <= 0, return 0 integerLog2 :: Integer -> Word +{-# INLINE integerLog2 #-} -- See Note [Integer constant folding] integerLog2 !i = W# (integerLog2# i) -- | Logarithm (floor) for an arbitrary base @@ -962,6 +987,7 @@ integerLogBaseWord# base !i -- -- For numbers <= 0, return 0 integerLogBaseWord :: Word -> Integer -> Word +{-# INLINE integerLogBaseWord #-} -- See Note [Integer constant folding] integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) -- | Logarithm (floor) for an arbitrary base @@ -977,6 +1003,7 @@ integerLogBase# !base !i -- -- For numbers <= 0, return 0 integerLogBase :: Integer -> Integer -> Word +{-# INLINE integerLogBase #-} -- See Note [Integer constant folding] integerLogBase !base !i = W# (integerLogBase# base i) -- | Indicate if the value is a power of two and which one @@ -991,7 +1018,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer on 32-bit architectures integerFromInt64# :: Int64# -> Integer -{-# NOINLINE integerFromInt64# #-} +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !i | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) &&# (i `geInt64#` intToInt64# -0x80000000#)) @@ -1005,7 +1032,7 @@ integerFromInt64# !i -- | Convert a Word64# into an Integer on 32-bit architectures integerFromWord64# :: Word64# -> Integer -{-# NOINLINE integerFromWord64# #-} +{-# NOINLINE[0] integerFromWord64# #-} -- See Note [Integer constant folding] integerFromWord64# !w | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) = IS (int64ToInt# (word64ToInt64# w)) @@ -1014,14 +1041,14 @@ integerFromWord64# !w -- | Convert an Integer into an Int64# on 32-bit architectures integerToInt64# :: Integer -> Int64# -{-# NOINLINE integerToInt64# #-} +{-# NOINLINE[0] integerToInt64# #-} -- See Note [Integer constant folding] integerToInt64# (IS i) = intToInt64# i integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) -- | Convert an Integer into a Word64# on 32-bit architectures integerToWord64# :: Integer -> Word64# -{-# NOINLINE integerToWord64# #-} +{-# NOINLINE[0] integerToWord64# #-} -- See Note [Integer constant folding] integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) integerToWord64# (IP b) = bigNatToWord64# b integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) @@ -1030,6 +1057,7 @@ integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatTo -- | Convert an Int64# into an Integer on 64-bit architectures integerFromInt64# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !x = IS x #endif @@ -1040,18 +1068,19 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# NOINLINE[0] integerDecodeDouble# #-} -- See Note [Integer constant folding] integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble :: Double -> (Integer, Int) +{-# INLINE integerDecodeDouble #-} -- See Note [Integer constant folding] integerDecodeDouble (D# x) = case integerDecodeDouble# x of (# m, e #) -> (m, I# e) -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# -{-# NOINLINE integerEncodeDouble# #-} +{-# NOINLINE[0] integerEncodeDouble# #-} -- See Note [Integer constant folding] integerEncodeDouble# (IS i) 0# = int2Double# i integerEncodeDouble# (IS i) e = intEncodeDouble# i e integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e @@ -1059,23 +1088,24 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) -- | Encode (Integer mantissa, Int exponent) into a Double integerEncodeDouble :: Integer -> Int -> Double +{-# INLINE integerEncodeDouble #-} -- See Note [Integer constant folding] integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) -- | Encode an Integer (mantissa) into a Double# integerToDouble# :: Integer -> Double# -{-# NOINLINE integerToDouble# #-} +{-# NOINLINE[0] integerToDouble# #-} -- See Note [Integer constant folding] integerToDouble# !i = integerEncodeDouble# i 0# -- | Encode an Integer (mantissa) into a Float# integerToFloat# :: Integer -> Float# -{-# NOINLINE integerToFloat# #-} +{-# NOINLINE[0] integerToFloat# #-} -- See Note [Integer constant folding] integerToFloat# !i = integerEncodeFloat# i 0# -- | Encode (# Integer mantissa, Int# exponent #) into a Float# -- -- TODO: Not sure if it's worth to write 'Float' optimized versions here integerEncodeFloat# :: Integer -> Int# -> Float# -{-# NOINLINE integerEncodeFloat# #-} +{-# NOINLINE[0] integerEncodeFloat# #-} -- See Note [Integer constant folding] integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) @@ -1105,6 +1135,7 @@ integerToAddr# (IN n) = bigNatToAddr# n -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +{-# INLINE integerToAddr #-} -- See Note [Integer constant folding] integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1132,6 +1163,7 @@ integerFromAddr# sz addr e s = -- -- Null higher limbs are automatically trimed. integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +{-# INLINE integerFromAddr #-} -- See Note [Integer constant folding] integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) @@ -1154,6 +1186,7 @@ integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +{-# INLINE integerToMutableByteArray #-} -- See Note [Integer constant folding] integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of (# s', r #) -> (# s', W# r #) @@ -1180,6 +1213,7 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of -- -- Null higher limbs are automatically trimed. integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +{-# INLINE integerFromByteArray #-} -- See Note [Integer constant folding] integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i @@ -1212,5 +1246,36 @@ integerGcde :: Integer -> Integer -> ( Integer, Integer, Integer) +{-# INLINE integerGcde #-} -- See Note [Integer constant folding] integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) + +{- Note [Integer constant folding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We define constant folding rules in "GHC.Core.Opt.ConstantFold" for most of the + at integer*#@ operations in this module, hence they are marked NOINLINE[0]. + +Why NOINLINE[0] rather than NOINLINE? Because + + 1. We still delay inlining long enough for the constant-folding RULEs + to fire + 2. The compiler has the option to inlining the operations late, possibly + cancelling away boxes in the process. + +Why NOINLINE[0] rather than INLINE? Because + + 3. We don't unconditionally inline huge definitions such as + `integerDiv`, which would lead to code bloat at pretty much no + gain. + 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. + `integerDiv`, there is no gain in inlining the unoptimised + unfoldings. + +But since we potentially inline the constant folded operations in phase 0, we +have to make sure that *all* callers that want to take part in constant folding +are marked INLINE. Otherwise, we'd store optimised unfoldings for them, in which +the constant folded functions are inlined. +That concerns for most of the @integer*@ without trailing hash in this module, +as well as the type class instances for 'Eq', 'Ord', 'Num', 'Integral', +'RealFloat' (which is for 'Double'!), etc. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e415b4b3eeb8a28608e1790d738be89d0818550b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e415b4b3eeb8a28608e1790d738be89d0818550b You're receiving 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 30 14:09:55 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 10:09:55 -0400 Subject: [Git][ghc/ghc][wip/T18765] s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) Message-ID: <5f7491b3bd217_80b3f848694ae7c156172f8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18765 at Glasgow Haskell Compiler / GHC Commits: c0bb5b71 by Sebastian Graf at 2020-09-30T16:09:45+02:00 s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) This defeats constant-folding in the final phases of the Simplifier, but enables us to get rid of allocations by inlining calls that can't be constant-folded. `NOINLINE[0]` is a better choice than `NOINLINE`, because 1. We still delay inlining long enough for the constant-folding RULEs to fire 2. The compiler has the option to inlining them late, possibly cancelling away boxes in the process. `NOINLINE[0]` is a better choice than `INLINE[0]`, because 3. We don't unconditionally inline huge definitions such as `integerDiv`, which would lead to code bloat at pretty much no gain. 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. `integerDiv`, there is no gain in inlining the unoptimised unfoldings. We also have to mark all callers that want to participate in constant folding as `INLINE`. See the new `Note [Integer constant folding]` for details. I had to change the `Num.fromInteger` and `Integral.toInteger` implementations of `Int*` and `Word*` variants to call the constant folded `integerToInt*#` and `integerToWord*#` variants directly to ensure constant folding. Fixes #18765. - - - - - 7 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/GHC/Word.hs - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1347,7 +1347,7 @@ builtinBignumRules _ = , rule_shift_op "integerShiftL" integerShiftLName shiftL , rule_shift_op "integerShiftR" integerShiftRName shiftR , rule_integerBit "integerBit" integerBitName - -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs + -- See Note [Integer constant folding] in "GHC.Num.Integer" , rule_divop_one "integerQuot" integerQuotName quot , rule_divop_one "integerRem" integerRemName rem , rule_divop_one "integerDiv" integerDivName div ===================================== libraries/base/GHC/Float.hs ===================================== @@ -494,6 +494,7 @@ instance Num Double where -- | @since 2.01 instance Real Double where + {-# INLINE toRational #-} -- See Note [Integer constant folding] toRational (D# x#) = case integerDecodeDouble# x# of (# m, e# #) @@ -580,11 +581,7 @@ instance Floating Double where -- | @since 2.01 instance RealFrac Double where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} - + {-# INLINE properFraction #-} -- See Note [Integer constant folding] properFraction x = case (decodeFloat x) of { (m,n) -> if n >= 0 then @@ -595,9 +592,11 @@ instance RealFrac Double where } } + {-# INLINE truncate #-} -- See Note [Integer constant folding] truncate x = case properFraction x of (n,_) -> n + {-# INLINE round #-} -- See Note [Integer constant folding] round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 @@ -608,9 +607,11 @@ instance RealFrac Double where EQ -> if even n then n else m GT -> m + {-# INLINE ceiling #-} -- See Note [Integer constant folding] ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n + {-# INLINE floor #-} -- See Note [Integer constant folding] floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n @@ -620,18 +621,23 @@ instance RealFloat Double where floatDigits _ = DBL_MANT_DIG -- ditto floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto + {-# INLINE decodeFloat #-} -- See Note [Integer constant folding] decodeFloat (D# x#) = case integerDecodeDouble# x# of (# i, j #) -> (i, I# j) + {-# INLINE encodeFloat #-} -- See Note [Integer constant folding] encodeFloat i (I# j) = D# (integerEncodeDouble# i j) + {-# INLINE exponent #-} -- See Note [Integer constant folding] exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x + {-# INLINE significand #-} -- See Note [Integer constant folding] significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) + {-# INLINE scaleFloat #-} -- See Note [Integer constant folding] scaleFloat 0 x = x scaleFloat k x | isFix = x ===================================== libraries/base/GHC/Int.hs ===================================== @@ -106,6 +106,7 @@ instance Num Int8 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I8# (narrow8Int# (integerToInt# i)) -- | @since 2.01 @@ -160,7 +161,8 @@ instance Integral Int8 where (# d, m #) -> (I8# (narrow8Int# d), I8# (narrow8Int# m)) - toInteger (I8# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I8# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int8 where @@ -313,6 +315,7 @@ instance Num Int16 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I16# (narrow16Int# (integerToInt# i)) -- | @since 2.01 @@ -367,7 +370,8 @@ instance Integral Int16 where (# d, m #) -> (I16# (narrow16Int# d), I16# (narrow16Int# m)) - toInteger (I16# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I16# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int16 where @@ -525,6 +529,7 @@ instance Num Int32 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I32# (narrow32Int# (integerToInt# i)) -- | @since 2.01 @@ -587,7 +592,8 @@ instance Integral Int32 where (# d, m #) -> (I32# (narrow32Int# d), I32# (narrow32Int# m)) - toInteger (I32# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I32# x) = integerFromInt64# x -- | @since 2.01 instance Read Int32 where @@ -748,6 +754,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt64# i) -- | @since 2.01 @@ -804,6 +811,7 @@ instance Integral Int64 where | y == (-1) && x == minBound = (overflowError, 0) | otherwise = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (I64# x) = integerFromInt64# x @@ -953,6 +961,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt# i) -- | @since 2.01 @@ -1006,7 +1015,8 @@ instance Integral Int64 where | otherwise = case x# `divModInt#` y# of (# d, m #) -> (I64# d, I64# m) - toInteger (I64# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I64# x) = integerFromInt64# x -- | @since 2.01 instance Read Int64 where ===================================== libraries/base/GHC/Num.hs ===================================== @@ -109,7 +109,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 - {-# INLINE fromInteger #-} -- Just to be sure! + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToInt i -- | @since 2.01 @@ -121,6 +121,7 @@ instance Num Word where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToWord i -- | @since 2.01 @@ -150,6 +151,7 @@ instance Num Natural where | naturalIsZero x = x | otherwise = raise# underflowException + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger x | x < 0 = raise# underflowException | otherwise = integerToNaturalClamp x @@ -160,4 +162,3 @@ instance Num Natural where {-# DEPRECATED quotRemInteger "Use integerQuotRem# instead" #-} quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) quotRemInteger = integerQuotRem# - ===================================== libraries/base/GHC/Real.hs ===================================== @@ -324,7 +324,8 @@ instance Real Int where -- | @since 2.0.1 instance Integral Int where - toInteger (I# i) = IS i + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I# x) = integerFromInt# x a `quot` b | b == 0 = divZeroError @@ -399,6 +400,7 @@ instance Integral Word where divMod (W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W# x#) = integerFromWord# x# -------------------------------------------------------------- @@ -413,71 +415,60 @@ instance Real Integer where instance Real Natural where toRational n = integerFromNatural n :% 1 --- Note [Integer division constant folding] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Constant folding of quot, rem, div, mod, divMod and quotRem for Integer --- arguments depends crucially on inlining. Constant folding rules defined in --- GHC.Core.Opt.ConstantFold trigger for integerQuot, integerRem and so on. --- So if calls to quot, rem and so on were not inlined the rules would not fire. --- --- The rules would also not fire if calls to integerQuot and so on were inlined, --- but this does not happen because they are all marked with NOINLINE pragma. - - -- | @since 2.0.1 instance Integral Integer where toInteger n = n - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `integerQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `integerRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `integerDiv` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `integerMod` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `integerDivMod` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `integerQuotRem` d -- | @since 4.8.0.0 instance Integral Natural where + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger = integerFromNatural - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `naturalQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `naturalRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `naturalQuot` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `naturalRem` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `naturalQuotRem` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `naturalQuotRem` d ===================================== libraries/base/GHC/Word.hs ===================================== @@ -112,6 +112,7 @@ instance Num Word8 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W8# (narrow8Word# (integerToWord# i)) -- | @since 2.01 @@ -156,7 +157,8 @@ instance Integral Word8 where divMod (W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W8# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W8# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word8 where @@ -303,6 +305,7 @@ instance Num Word16 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W16# (narrow16Word# (integerToWord# i)) -- | @since 2.01 @@ -347,7 +350,8 @@ instance Integral Word16 where divMod (W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W16# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W16# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word16 where @@ -533,6 +537,7 @@ instance Num Word32 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W32# (narrow32Word# (integerToWord# i)) -- | @since 2.01 @@ -587,15 +592,8 @@ instance Integral Word32 where divMod (W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W32# x#) -#if WORD_SIZE_IN_BITS == 32 - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# -#else - = IS (word2Int# x#) -#endif + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W32# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word32 where @@ -728,6 +726,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord64# i) -- | @since 2.01 @@ -770,6 +769,7 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W64# x#) = integerFromWord64# x# -- | @since 2.01 @@ -875,6 +875,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord# i) -- | @since 2.01 @@ -953,11 +954,8 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W64# x#) - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W64# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word64 where ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -66,6 +66,7 @@ integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND -- | Check Integer invariants integerCheck :: Integer -> Bool +{-# INLINE integerCheck #-} integerCheck i = isTrue# (integerCheck# i) -- | Integer Zero @@ -137,6 +138,7 @@ integerToBigNatClamp# _ = bigNatZero# (# #) -- | Create an Integer from an Int# integerFromInt# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt# #-} -- See Note [Integer constant folding] integerFromInt# i = IS i -- | Create an Integer from an Int @@ -145,18 +147,19 @@ integerFromInt (I# i) = IS i -- | Truncates 'Integer' to least-significant 'Int#' integerToInt# :: Integer -> Int# -{-# NOINLINE integerToInt# #-} +{-# NOINLINE[0] integerToInt# #-} -- See Note [Integer constant folding] integerToInt# (IS i) = i integerToInt# (IP b) = word2Int# (bigNatToWord# b) integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) -- | Truncates 'Integer' to least-significant 'Int#' integerToInt :: Integer -> Int +{-# INLINE integerToInt #-} -- See Note [Integer constant folding] integerToInt i = I# (integerToInt# i) -- | Convert a Word# into an Integer integerFromWord# :: Word# -> Integer -{-# NOINLINE integerFromWord# #-} +{-# NOINLINE[0] integerFromWord# #-} -- See Note [Integer constant folding] integerFromWord# w | i <- word2Int# w , isTrue# (i >=# 0#) @@ -167,6 +170,7 @@ integerFromWord# w -- | Convert a Word into an Integer integerFromWord :: Word -> Integer +{-# INLINE integerFromWord #-} -- See Note [Integer constant folding] integerFromWord (W# w) = integerFromWord# w -- | Create a negative Integer with the given Word magnitude @@ -185,23 +189,25 @@ integerFromWordSign# _ w = integerFromWordNeg# w -- | Truncate an Integer into a Word integerToWord# :: Integer -> Word# -{-# NOINLINE integerToWord# #-} +{-# NOINLINE[0] integerToWord# #-} -- See Note [Integer constant folding] integerToWord# (IS i) = int2Word# i integerToWord# (IP bn) = bigNatToWord# bn integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) -- | Truncate an Integer into a Word integerToWord :: Integer -> Word +{-# INLINE integerToWord #-} -- See Note [Integer constant folding] integerToWord !i = W# (integerToWord# i) -- | Convert a Natural into an Integer integerFromNatural :: Natural -> Integer -{-# NOINLINE integerFromNatural #-} +{-# NOINLINE[0] integerFromNatural #-} -- See Note [Integer constant folding] integerFromNatural (NS x) = integerFromWord# x integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer +{-# INLINE integerFromWordList #-} -- See Note [Integer constant folding] integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) @@ -209,7 +215,7 @@ integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- -- Return 0 for negative Integers. integerToNaturalClamp :: Integer -> Natural -{-# NOINLINE integerToNaturalClamp #-} +{-# NOINLINE[0] integerToNaturalClamp #-} -- See Note [Integer constant folding] integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) @@ -220,7 +226,7 @@ integerToNaturalClamp (IN _) = naturalZero -- -- Return absolute value integerToNatural :: Integer -> Natural -{-# NOINLINE integerToNatural #-} +{-# NOINLINE[0] integerToNatural #-} -- See Note [Integer constant folding] integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x @@ -237,40 +243,48 @@ integerIsNegative# (IN _) = 1# -- | Negative predicate integerIsNegative :: Integer -> Bool +{-# INLINE integerIsNegative #-} -- See Note [Integer constant folding] integerIsNegative !i = isTrue# (integerIsNegative# i) -- | Zero predicate integerIsZero :: Integer -> Bool +{-# INLINE integerIsZero #-} -- See Note [Integer constant folding] integerIsZero (IS 0#) = True integerIsZero _ = False -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool +{-# INLINE integerNe #-} -- See Note [Integer constant folding] integerNe !x !y = isTrue# (integerNe# x y) -- | Equal predicate. integerEq :: Integer -> Integer -> Bool +{-# INLINE integerEq #-} -- See Note [Integer constant folding] integerEq !x !y = isTrue# (integerEq# x y) -- | Lower-or-equal predicate. integerLe :: Integer -> Integer -> Bool +{-# INLINE integerLe #-} -- See Note [Integer constant folding] integerLe !x !y = isTrue# (integerLe# x y) -- | Lower predicate. integerLt :: Integer -> Integer -> Bool +{-# INLINE integerLt #-} -- See Note [Integer constant folding] integerLt !x !y = isTrue# (integerLt# x y) -- | Greater predicate. integerGt :: Integer -> Integer -> Bool +{-# INLINE integerGt #-} -- See Note [Integer constant folding] integerGt !x !y = isTrue# (integerGt# x y) -- | Greater-or-equal predicate. integerGe :: Integer -> Integer -> Bool +{-# INLINE integerGe #-} -- See Note [Integer constant folding] integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} +{-# NOINLINE[0] integerEq# #-} -- See Note [Integer constant folding] integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -278,7 +292,7 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} +{-# NOINLINE[0] integerNe# #-} -- See Note [Integer constant folding] integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -286,39 +300,41 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} +{-# NOINLINE[0] integerGt# #-} -- See Note [Integer constant folding] integerGt# (IS x) (IS y) = x ># y integerGt# x y | GT <- integerCompare x y = 1# integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} +{-# NOINLINE[0] integerLe# #-} -- See Note [Integer constant folding] integerLe# (IS x) (IS y) = x <=# y integerLe# x y | GT <- integerCompare x y = 0# integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} +{-# NOINLINE[0] integerLt# #-} -- See Note [Integer constant folding] integerLt# (IS x) (IS y) = x <# y integerLt# x y | LT <- integerCompare x y = 1# integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} +{-# NOINLINE[0] integerGe# #-} -- See Note [Integer constant folding] integerGe# (IS x) (IS y) = x >=# y integerGe# x y | LT <- integerCompare x y = 0# integerGe# _ _ = 1# instance Eq Integer where + {-# INLINE (==) #-} -- See Note [Integer constant folding] (==) = integerEq + {-# INLINE (/=) #-} -- See Note [Integer constant folding] (/=) = integerNe -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} +{-# NOINLINE[0] integerCompare #-} -- See Note [Integer constant folding] integerCompare (IS x) (IS y) = compareInt# x y integerCompare (IP x) (IP y) = bigNatCompare x y integerCompare (IN x) (IN y) = bigNatCompare y x @@ -330,6 +346,7 @@ integerCompare (IP _) (IN _) = GT integerCompare (IN _) (IP _) = LT instance Ord Integer where + {-# INLINE compare #-} -- See Note [Integer constant folding] compare = integerCompare --------------------------------------------------------------------- @@ -338,7 +355,7 @@ instance Ord Integer where -- | Subtract one 'Integer' from another. integerSub :: Integer -> Integer -> Integer -{-# NOINLINE integerSub #-} +{-# NOINLINE[0] integerSub #-} -- See Note [Integer constant folding] integerSub !x (IS 0#) = x integerSub (IS x#) (IS y#) = case subIntC# x# y# of @@ -384,7 +401,7 @@ integerSub (IN x) (IS y#) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer -{-# NOINLINE integerAdd #-} +{-# NOINLINE[0] integerAdd #-} -- See Note [Integer constant folding] integerAdd !x (IS 0#) = x integerAdd (IS 0#) y = y integerAdd (IS x#) (IS y#) @@ -413,7 +430,7 @@ integerAdd (IP x) (IN y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer -{-# NOINLINE integerMul #-} +{-# NOINLINE[0] integerMul #-} -- See Note [Integer constant folding] integerMul !_ (IS 0#) = IS 0# integerMul (IS 0#) _ = IS 0# integerMul x (IS 1#) = x @@ -478,7 +495,7 @@ integerMul (IN x) (IS y) -- IP is used iff n > maxBound::Int -- IN is used iff n < minBound::Int integerNegate :: Integer -> Integer -{-# NOINLINE integerNegate #-} +{-# NOINLINE[0] integerNegate #-} -- See Note [Integer constant folding] integerNegate (IN b) = IP b integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) integerNegate (IS i) = IS (negateInt# i) @@ -489,7 +506,7 @@ integerNegate (IP b) -- | Compute absolute value of an 'Integer' integerAbs :: Integer -> Integer -{-# NOINLINE integerAbs #-} +{-# NOINLINE[0] integerAbs #-} -- See Note [Integer constant folding] integerAbs (IN i) = IP i integerAbs n@(IP _) = n integerAbs n@(IS i) @@ -501,13 +518,13 @@ integerAbs n@(IS i) -- | Return @-1@, @0@, and @1@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum :: Integer -> Integer -{-# NOINLINE integerSignum #-} +{-# NOINLINE[0] integerSignum #-} -- See Note [Integer constant folding] integerSignum !j = IS (integerSignum# j) -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum# :: Integer -> Int# -{-# NOINLINE integerSignum# #-} +{-# NOINLINE[0] integerSignum# #-} -- See Note [Integer constant folding] integerSignum# (IN _) = -1# integerSignum# (IS i#) = sgnI# i# integerSignum# (IP _ ) = 1# @@ -515,7 +532,7 @@ integerSignum# (IP _ ) = 1# -- | Count number of set bits. For negative arguments returns -- the negated population count of the absolute value. integerPopCount# :: Integer -> Int# -{-# NOINLINE integerPopCount# #-} +{-# NOINLINE[0] integerPopCount# #-} -- See Note [Integer constant folding] integerPopCount# (IS i) | isTrue# (i >=# 0#) = word2Int# (popCntI# i) | True = negateInt# (word2Int# (popCntI# (negateInt# i))) @@ -524,7 +541,7 @@ integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) -- | Positive 'Integer' for which only /n/-th bit is set integerBit# :: Word# -> Integer -{-# NOINLINE integerBit# #-} +{-# NOINLINE[0] integerBit# #-} -- See Note [Integer constant folding] integerBit# i | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) = IS (uncheckedIShiftL# 1# (word2Int# i)) @@ -533,13 +550,14 @@ integerBit# i -- | 'Integer' for which only /n/-th bit is set integerBit :: Word -> Integer +{-# INLINE integerBit #-} -- See Note [Integer constant folding] integerBit (W# i) = integerBit# i -- | Test if /n/-th bit is set. -- -- Fake 2's complement for negative values (might be slow) integerTestBit# :: Integer -> Word# -> Bool# -{-# NOINLINE integerTestBit# #-} +{-# NOINLINE[0] integerTestBit# #-} -- See Note [Integer constant folding] integerTestBit# (IS x) i | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = testBitI# x i @@ -569,13 +587,14 @@ integerTestBit# (IN x) i -- -- Fake 2's complement for negative values (might be slow) integerTestBit :: Integer -> Word -> Bool +{-# INLINE integerTestBit #-} -- See Note [Integer constant folding] integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) -- | Shift-right operation -- -- Fake 2's complement for negative values (might be slow) integerShiftR# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftR# #-} +{-# NOINLINE[0] integerShiftR# #-} -- See Note [Integer constant folding] integerShiftR# !x 0## = x integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) where @@ -592,11 +611,12 @@ integerShiftR# (IN bn) n = -- -- Fake 2's complement for negative values (might be slow) integerShiftR :: Integer -> Word -> Integer +{-# INLINE integerShiftR #-} -- See Note [Integer constant folding] integerShiftR !x (W# w) = integerShiftR# x w -- | Shift-left operation integerShiftL# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftL# #-} +{-# NOINLINE[0] integerShiftL# #-} -- See Note [Integer constant folding] integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n @@ -611,13 +631,14 @@ integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) -- Remember that bits are stored in sign-magnitude form, hence the behavior of -- negative Integers is different from negative Int's behavior. integerShiftL :: Integer -> Word -> Integer +{-# INLINE integerShiftL #-} -- See Note [Integer constant folding] integerShiftL !x (W# w) = integerShiftL# x w -- | Bitwise OR operation -- -- Fake 2's complement for negative values (might be slow) integerOr :: Integer -> Integer -> Integer -{-# NOINLINE integerOr #-} +{-# NOINLINE[0] integerOr #-} -- See Note [Integer constant folding] integerOr a b = case a of IS 0# -> b IS -1# -> IS -1# @@ -676,7 +697,7 @@ integerOr a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerXor :: Integer -> Integer -> Integer -{-# NOINLINE integerXor #-} +{-# NOINLINE[0] integerXor #-} -- See Note [Integer constant folding] integerXor a b = case a of IS 0# -> b IS -1# -> integerComplement b @@ -731,7 +752,7 @@ integerXor a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerAnd :: Integer -> Integer -> Integer -{-# NOINLINE integerAnd #-} +{-# NOINLINE[0] integerAnd #-} -- See Note [Integer constant folding] integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> b @@ -766,7 +787,7 @@ integerAnd a b = case a of -- | Binary complement of the integerComplement :: Integer -> Integer -{-# NOINLINE integerComplement #-} +{-# NOINLINE[0] integerComplement #-} -- See Note [Integer constant folding] integerComplement (IS x) = IS (notI# x) integerComplement (IP x) = IN (bigNatAddWord# x 1##) integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) @@ -777,7 +798,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerQuotRem# #-} +{-# NOINLINE[0] integerQuotRem# #-} -- See Note [Integer constant folding] integerQuotRem# !n (IS 1#) = (# n, IS 0# #) integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) integerQuotRem# !_ (IS 0#) = case raiseDivZero of @@ -815,12 +836,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerQuotRem #-} -- See Note [Integer constant folding] integerQuotRem !x !y = case integerQuotRem# x y of (# q, r #) -> (q, r) integerQuot :: Integer -> Integer -> Integer -{-# NOINLINE integerQuot #-} +{-# NOINLINE[0] integerQuot #-} -- See Note [Integer constant folding] integerQuot !n (IS 1#) = n integerQuot !n (IS -1#) = integerNegate n integerQuot !_ (IS 0#) = raiseDivZero @@ -841,7 +863,7 @@ integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer -{-# NOINLINE integerRem #-} +{-# NOINLINE[0] integerRem #-} -- See Note [Integer constant folding] integerRem !_ (IS 1#) = IS 0# integerRem _ (IS -1#) = IS 0# integerRem _ (IS 0#) = IS (remInt# 0# 0#) @@ -863,7 +885,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerDivMod# #-} +{-# NOINLINE[0] integerDivMod# #-} -- See Note [Integer constant folding] integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) = let !q' = integerSub q (IS 1#) @@ -878,12 +900,13 @@ integerDivMod# !n !d -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerDivMod #-} -- See Note [Integer constant folding] integerDivMod !n !d = case integerDivMod# n d of (# q,r #) -> (q,r) integerDiv :: Integer -> Integer -> Integer -{-# NOINLINE integerDiv #-} +{-# NOINLINE[0] integerDiv #-} -- See Note [Integer constant folding] integerDiv !n !d -- same-sign ops can be handled by more efficient 'integerQuot' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d @@ -891,7 +914,7 @@ integerDiv !n !d integerMod :: Integer -> Integer -> Integer -{-# NOINLINE integerMod #-} +{-# NOINLINE[0] integerMod #-} -- See Note [Integer constant folding] integerMod !n !d -- same-sign ops can be handled by more efficient 'integerRem' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d @@ -899,7 +922,7 @@ integerMod !n !d -- | Compute greatest common divisor. integerGcd :: Integer -> Integer -> Integer -{-# NOINLINE integerGcd #-} +{-# NOINLINE[0] integerGcd #-} -- See Note [Integer constant folding] integerGcd (IS 0#) !b = integerAbs b integerGcd a (IS 0#) = integerAbs a integerGcd (IS 1#) _ = IS 1# @@ -917,7 +940,7 @@ integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (ab -- | Compute least common multiple. integerLcm :: Integer -> Integer -> Integer -{-# NOINLINE integerLcm #-} +{-# NOINLINE[0] integerLcm #-} -- See Note [Integer constant folding] integerLcm (IS 0#) !_ = IS 0# integerLcm (IS 1#) b = integerAbs b integerLcm (IS -1#) b = integerAbs b @@ -931,6 +954,7 @@ integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab -- | Square a Integer integerSqr :: Integer -> Integer +{-# INLINE integerSqr #-} -- See Note [Integer constant folding] integerSqr !a = integerMul a a @@ -948,6 +972,7 @@ integerLog2# (IP b) = bigNatLog2# b -- -- For numbers <= 0, return 0 integerLog2 :: Integer -> Word +{-# INLINE integerLog2 #-} -- See Note [Integer constant folding] integerLog2 !i = W# (integerLog2# i) -- | Logarithm (floor) for an arbitrary base @@ -962,6 +987,7 @@ integerLogBaseWord# base !i -- -- For numbers <= 0, return 0 integerLogBaseWord :: Word -> Integer -> Word +{-# INLINE integerLogBaseWord #-} -- See Note [Integer constant folding] integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) -- | Logarithm (floor) for an arbitrary base @@ -977,6 +1003,7 @@ integerLogBase# !base !i -- -- For numbers <= 0, return 0 integerLogBase :: Integer -> Integer -> Word +{-# INLINE integerLogBase #-} -- See Note [Integer constant folding] integerLogBase !base !i = W# (integerLogBase# base i) -- | Indicate if the value is a power of two and which one @@ -991,7 +1018,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer on 32-bit architectures integerFromInt64# :: Int64# -> Integer -{-# NOINLINE integerFromInt64# #-} +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !i | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) &&# (i `geInt64#` intToInt64# -0x80000000#)) @@ -1005,7 +1032,7 @@ integerFromInt64# !i -- | Convert a Word64# into an Integer on 32-bit architectures integerFromWord64# :: Word64# -> Integer -{-# NOINLINE integerFromWord64# #-} +{-# NOINLINE[0] integerFromWord64# #-} -- See Note [Integer constant folding] integerFromWord64# !w | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) = IS (int64ToInt# (word64ToInt64# w)) @@ -1014,14 +1041,14 @@ integerFromWord64# !w -- | Convert an Integer into an Int64# on 32-bit architectures integerToInt64# :: Integer -> Int64# -{-# NOINLINE integerToInt64# #-} +{-# NOINLINE[0] integerToInt64# #-} -- See Note [Integer constant folding] integerToInt64# (IS i) = intToInt64# i integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) -- | Convert an Integer into a Word64# on 32-bit architectures integerToWord64# :: Integer -> Word64# -{-# NOINLINE integerToWord64# #-} +{-# NOINLINE[0] integerToWord64# #-} -- See Note [Integer constant folding] integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) integerToWord64# (IP b) = bigNatToWord64# b integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) @@ -1030,6 +1057,7 @@ integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatTo -- | Convert an Int64# into an Integer on 64-bit architectures integerFromInt64# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !x = IS x #endif @@ -1040,18 +1068,19 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# NOINLINE[0] integerDecodeDouble# #-} -- See Note [Integer constant folding] integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble :: Double -> (Integer, Int) +{-# INLINE integerDecodeDouble #-} -- See Note [Integer constant folding] integerDecodeDouble (D# x) = case integerDecodeDouble# x of (# m, e #) -> (m, I# e) -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# -{-# NOINLINE integerEncodeDouble# #-} +{-# NOINLINE[0] integerEncodeDouble# #-} -- See Note [Integer constant folding] integerEncodeDouble# (IS i) 0# = int2Double# i integerEncodeDouble# (IS i) e = intEncodeDouble# i e integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e @@ -1059,23 +1088,24 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) -- | Encode (Integer mantissa, Int exponent) into a Double integerEncodeDouble :: Integer -> Int -> Double +{-# INLINE integerEncodeDouble #-} -- See Note [Integer constant folding] integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) -- | Encode an Integer (mantissa) into a Double# integerToDouble# :: Integer -> Double# -{-# NOINLINE integerToDouble# #-} +{-# NOINLINE[0] integerToDouble# #-} -- See Note [Integer constant folding] integerToDouble# !i = integerEncodeDouble# i 0# -- | Encode an Integer (mantissa) into a Float# integerToFloat# :: Integer -> Float# -{-# NOINLINE integerToFloat# #-} +{-# NOINLINE[0] integerToFloat# #-} -- See Note [Integer constant folding] integerToFloat# !i = integerEncodeFloat# i 0# -- | Encode (# Integer mantissa, Int# exponent #) into a Float# -- -- TODO: Not sure if it's worth to write 'Float' optimized versions here integerEncodeFloat# :: Integer -> Int# -> Float# -{-# NOINLINE integerEncodeFloat# #-} +{-# NOINLINE[0] integerEncodeFloat# #-} -- See Note [Integer constant folding] integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) @@ -1105,6 +1135,7 @@ integerToAddr# (IN n) = bigNatToAddr# n -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +{-# INLINE integerToAddr #-} -- See Note [Integer constant folding] integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1132,6 +1163,7 @@ integerFromAddr# sz addr e s = -- -- Null higher limbs are automatically trimed. integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +{-# INLINE integerFromAddr #-} -- See Note [Integer constant folding] integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) @@ -1154,6 +1186,7 @@ integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +{-# INLINE integerToMutableByteArray #-} -- See Note [Integer constant folding] integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of (# s', r #) -> (# s', W# r #) @@ -1180,6 +1213,7 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of -- -- Null higher limbs are automatically trimed. integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +{-# INLINE integerFromByteArray #-} -- See Note [Integer constant folding] integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i @@ -1212,5 +1246,36 @@ integerGcde :: Integer -> Integer -> ( Integer, Integer, Integer) +{-# INLINE integerGcde #-} -- See Note [Integer constant folding] integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) + +{- Note [Integer constant folding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We define constant folding rules in "GHC.Core.Opt.ConstantFold" for most of the + at integer*#@ operations in this module, hence they are marked NOINLINE[0]. + +Why NOINLINE[0] rather than NOINLINE? Because + + 1. We still delay inlining long enough for the constant-folding RULEs + to fire + 2. The compiler has the option to inlining the operations late, possibly + cancelling away boxes in the process. + +Why NOINLINE[0] rather than INLINE? Because + + 3. We don't unconditionally inline huge definitions such as + `integerDiv`, which would lead to code bloat at pretty much no + gain. + 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. + `integerDiv`, there is no gain in inlining the unoptimised + unfoldings. + +But since we potentially inline the constant folded operations in phase 0, we +have to make sure that *all* callers that want to take part in constant folding +are marked INLINE. Otherwise, we'd store optimised unfoldings for them, in which +the constant folded functions are inlined. +That concerns for most of the @integer*@ without trailing hash in this module, +as well as the type class instances for 'Eq', 'Ord', 'Num', 'Integral', +'RealFloat' (which is for 'Double'!), etc. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0bb5b71694df072e356ee899f710ad1f7067e11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0bb5b71694df072e356ee899f710ad1f7067e11 You're receiving 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 30 14:12:22 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 10:12:22 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f7492462c8ec_80ba85ba24156176e3@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: 57c598ac by Sebastian Graf at 2020-09-30T16:11:33+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -178,7 +178,7 @@ cprAnal' env (Lam var body) | otherwise = (lam_ty, Lam var body') where - env' = extendAnalEnvForDemand env var (idDemandInfo var) + env' = extendSigEnvForDemand env var (idDemandInfo var) (body_ty, body') = cprAnal env' body lam_ty = abstractCprTy body_ty @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -251,46 +250,43 @@ cprTransform env id -- Recursive bindings cprFix :: TopLevelFlag - -> AnalEnv -- Does not include bindings for this binding + -> AnalEnv -- Does not include bindings for this binding -> [(Id,CoreExpr)] - -> (AnalEnv, [(Id,CoreExpr)]) -- Binders annotated with stricness info - -cprFix top_lvl env orig_pairs - = loop 1 initial_pairs + -> (AnalEnv, [(Id,CoreExpr)]) -- Binders annotated with CPR info +cprFix top_lvl orig_env orig_pairs + = loop 1 init_env init_pairs where - bot_sig = mkCprSig 0 botCpr + init_sig id rhs + -- See Note [CPR for data structures] + | isDataStructure id rhs = topCprSig + | otherwise = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] - | otherwise = orig_pairs - - -- The fixed-point varies the idCprInfo field of the binders, and terminates if that - -- annotation does not change any more. - loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) - loop n pairs - | found_fixpoint = (final_anal_env, pairs') - | otherwise = loop (n+1) pairs' - where - found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs - first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') - - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + orig_virgin = ae_virgin orig_env + init_pairs | orig_virgin = [(setIdCprInfo id (init_sig id rhs), rhs) | (id, rhs) <- orig_pairs ] + | otherwise = orig_pairs + init_env = extendSigEnvList orig_env (map fst init_pairs) + + -- The fixed-point varies the idCprInfo field of the binders and and their + -- entries in the AnalEnv, and terminates if that annotation does not change + -- any more. + loop :: Int -> AnalEnv -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) + loop n env pairs + | found_fixpoint = (reset_env', pairs') + | otherwise = loop (n+1) env' pairs' where -- In all but the first iteration, delete the virgin flag - start_env | first_round = env - | otherwise = nonVirgin env - - start = extendAnalEnvs start_env (map fst pairs) - - (_, pairs') = mapAccumL my_downRhs start pairs - - my_downRhs env (id,rhs) - = (env', (id', rhs')) + -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal + (env', pairs') = step (applyWhen (n/=1) nonVirgin env) pairs + -- Make sure we reset the virgin flag to what it was when we are stable + reset_env' = env'{ ae_virgin = orig_virgin } + found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs + + step :: AnalEnv -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step env pairs = mapAccumL go env pairs + where + go env (id, rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +295,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +310,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendSigEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +324,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -394,15 +400,15 @@ emptyAnalEnv fam_envs , ae_fam_envs = fam_envs } --- | Extend an environment with the strictness IDs attached to the id -extendAnalEnvs :: AnalEnv -> [Id] -> AnalEnv -extendAnalEnvs env ids +-- | Extend an environment with the CPR sigs attached to the id +extendSigEnvList :: AnalEnv -> [Id] -> AnalEnv +extendSigEnvList env ids = env { ae_sigs = sigs' } where sigs' = extendVarEnvList (ae_sigs env) [ (id, idCprInfo id) | id <- ids ] -extendAnalEnv :: AnalEnv -> Id -> CprSig -> AnalEnv -extendAnalEnv env id sig +extendSigEnv :: AnalEnv -> Id -> CprSig -> AnalEnv +extendSigEnv env id sig = env { ae_sigs = extendVarEnv (ae_sigs env) id sig } lookupSigEnv :: AnalEnv -> Id -> Maybe CprSig @@ -411,17 +417,17 @@ lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } --- | A version of 'extendAnalEnv' for a binder of which we don't see the RHS +-- | A version of 'extendSigEnv' for a binder of which we don't see the RHS -- needed to compute a 'CprSig' (e.g. lambdas and DataAlt field binders). -- In this case, we can still look at their demand to attach CPR signatures -- anticipating the unboxing done by worker/wrapper. -- See Note [CPR for binders that will be unboxed]. -extendAnalEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv -extendAnalEnvForDemand env id dmd +extendSigEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv +extendSigEnvForDemand env id dmd | isId id , Just (_, DataConAppContext { dcac_dc = dc }) <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd - = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) + = extendSigEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise = env where @@ -436,7 +442,7 @@ extendEnvForDataAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv extendEnvForDataAlt env scrut case_bndr dc bndrs = foldl' do_con_arg env' ids_w_strs where - env' = extendAnalEnv env case_bndr (CprSig case_bndr_ty) + env' = extendSigEnv env case_bndr (CprSig case_bndr_ty) ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc @@ -460,7 +466,7 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs | is_var scrut -- See Note [Add demands for strict constructors] in GHC.Core.Opt.WorkWrap.Utils , let dmd = applyWhen (isMarkedStrict str) strictifyDmd (idDemandInfo id) - = extendAnalEnvForDemand env id dmd + = extendSigEnvForDemand env id dmd | otherwise = env @@ -645,17 +651,17 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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) @@ -663,28 +669,52 @@ should not get CPR signatures, because they * 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, +Hence we don't analyse or annotate data structures in 'cprAnalBind'. To +implement this, the isDataStructure guard is triggered for bindings that satisfy + + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +If lvl doesn't have the CPR property, fac won't either. But lvl is a data +structure, and hence (see above) will not have a CPR signature. So instead, when +'cprAnal' meets a variable lacking a CPR signature to extrapolate into a CPR +transformer, 'cprTransform' instead tries to get its unfolding (via +'cprDataStructureUnfolding_maybe'), and analyses that instead. 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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. + +It's also worth pointing out how ad-hoc this is: If we instead had + + f1 x = x:[] + f2 x = x : f1 x + f3 x = x : f2 x + ... + +we still give every function an every deepening CPR signature. But it's very +uncommon to find code like this, whereas the long static data structures from +the beginning of this Note are very common because of GHC's strategy of ANF'ing +data structure RHSs. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57c598acf4ea4627017ec680959e376e8c9c5b8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57c598acf4ea4627017ec680959e376e8c9c5b8d You're receiving 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 30 15:59:21 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 11:59:21 -0400 Subject: [Git][ghc/ghc][wip/strict-ttg] Fix test failures Message-ID: <5f74ab59eee0_80b3f847d6d9444156431a7@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/strict-ttg at Glasgow Haskell Compiler / GHC Commits: 67a0609b by Vladislav Zavialov at 2020-09-30T18:59:11+03:00 Fix test failures - - - - - 14 changed files: - compiler/GHC/Hs/Expr.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/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2402,9 +2402,9 @@ pprStmt (LastStmt _ expr m_dollar_stripped _) Just False -> text "return" Nothing -> empty) <+> ppr expr -pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr] +pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds] -pprStmt (BodyStmt _ expr _ _) = ppr expr +pprStmt (BodyStmt _ expr _ _) = pprBodyStmt expr pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) pprStmt (TransStmt { trS_stmts = stmts, trS_by = by @@ -2439,10 +2439,9 @@ pprStmt (ApplicativeStmt _ args mb_join) flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc] flattenArg (_, ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL))] + [pprBodyStmt expr] | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))] + [pprBindStmt pat expr] flattenArg (_, ApplicativeArgMany _ stmts _ _ _) = concatMap flattenStmt stmts @@ -2456,6 +2455,11 @@ pprStmt (ApplicativeStmt _ args mb_join) pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc pp_arg (_, applicativeArg) = ppr applicativeArg +pprBodyStmt :: Outputable expr => expr -> SDoc +pprBodyStmt expr = ppr expr + +pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc +pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr] instance (OutputableBndrId idL) => Outputable (ApplicativeArg (GhcPass idL)) where @@ -2464,17 +2468,14 @@ instance (OutputableBndrId idL) pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc pprArg (ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL)) + pprBodyStmt expr | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL)) + pprBindStmt pat expr pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> - ppr (HsDo (panic "pprStmt") ctxt (noLoc - (stmts ++ - [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])) - :: HsExpr (GhcPass idL)) + pprDo ctxt (stmts ++ + [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -102,7 +102,7 @@ import GHC.Types.Basic import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Data.FastString -import GHC.Utils.Misc ( count ) +import GHC.Utils.Misc ( count, Box ) import Data.Data hiding ( Fixity, Prefix, Infix ) import Data.Maybe @@ -1690,7 +1690,8 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: !(XCFieldOcc pass) deriving instance Eq (XCFieldOcc (GhcPass p)) => Eq (FieldOcc (GhcPass p)) type instance XCFieldOcc GhcPs = NoExtField -type instance XCFieldOcc GhcRn = Name +type instance XCFieldOcc GhcRn = Box Name -- the Box is needed due to 'expectJust' in 'rnField' + -- TODO: refactor to remove it type instance XCFieldOcc GhcTc = Id type instance XXFieldOcc (GhcPass _) = NoExtCon ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1135,7 +1135,7 @@ hsTyClForeignBinders tycl_decls foreign_decls foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls) where getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name] - getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs + getSelectorNames (ns, fs) = map unLoc ns ++ map (unBox . extFieldOcc . unLoc) fs ------------------- hsLTyClDeclBinders :: IsPass p ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Tc.Types +import GHC.Utils.Misc (unBox) import Control.Applicative import Data.Bifunctor (first) @@ -188,7 +189,7 @@ subordinates instMap decl = case decl of , maybeToList $ fmap unLoc $ con_doc c , conArgDocs c) | c <- cons, cname <- getConNames c ] - fields = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty) + fields = [ (unBox (extFieldOcc n), maybeToList $ fmap unLoc doc, M.empty) | RecCon flds <- map getConArgs cons , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1633,7 +1633,7 @@ repFields (HsRecFields { rec_flds = flds }) where rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.FieldExp)) - rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { fn <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; e <- repLE (hsRecFieldArg fld) ; repFieldExp fn e } @@ -1992,7 +1992,7 @@ repP (ConPat NoExtField dc details) } where rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat))) - rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { MkC v <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; MkC p <- repLP (hsRecFieldArg fld) ; rep2 fieldPatName [v,p] } @@ -2626,7 +2626,7 @@ repConstr (RecCon ips) resTy cons rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip) rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType)) - rep_one_ip t n = do { MkC v <- lookupOcc (extFieldOcc $ unLoc n) + rep_one_ip t n = do { MkC v <- lookupOcc (unBox (extFieldOcc (unLoc n))) ; MkC ty <- repBangTy t ; rep2 varBangTypeName [v,ty] } ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -21,6 +21,7 @@ Main functions for .hie file generation module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where +import GHC.Utils.Misc (Box(Box)) import GHC.Utils.Outputable(ppr) import GHC.Prelude @@ -1278,7 +1279,7 @@ instance ( ToHie (RFContext (Located label)) instance ToHie (RFContext (Located (FieldOcc GhcRn))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc name _ -> + FieldOcc (Box name) _ -> [ toHie $ C (RecField c rhs) (L nspan name) ] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1174,7 +1174,7 @@ rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) where lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn lookupField (FieldOcc _ (L lr rdr)) = - FieldOcc (flSelector fl) (L lr rdr) + FieldOcc (Box (flSelector fl)) (L lr rdr) where lbl = occNameFS $ rdrNameOcc rdr fl = expectJust "rnField" $ lookupFsEnv fl_env lbl ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -654,7 +654,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) else return arg ; return (L l (HsRecField { hsRecFieldLbl = (L loc (FieldOcc - sel (L ll lbl))) + (Box sel) (L ll lbl))) , hsRecFieldArg = arg' , hsRecPun = pun })) } @@ -697,7 +697,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; addUsedGREs dot_dot_gres ; return [ L loc (HsRecField - { hsRecFieldLbl = L loc (FieldOcc sel (L loc arg_rdr)) + { hsRecFieldLbl = L loc (FieldOcc (Box sel) (L loc arg_rdr)) , hsRecFieldArg = L loc (mk_arg loc arg_rdr) , hsRecPun = False }) | fl <- dot_dot_fields @@ -792,7 +792,7 @@ rnHsRecUpdFields flds getFieldIds :: [LHsRecField GhcRn arg] -> [Name] -getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds +getFieldIds flds = map (unBox . unLoc . hsRecFieldSel . unLoc) flds getFieldLbls :: [LHsRecField id arg] -> [RdrName] getFieldLbls flds ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1429,7 +1429,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds , hsRecFieldArg = rhs })) = do { let lbl = rdrNameAmbiguousFieldOcc af sel_id = selectorAmbiguousFieldOcc af - f = L loc (FieldOcc (idName sel_id) (L loc lbl)) + f = L loc (FieldOcc (Box (idName sel_id)) (L loc lbl)) ; mb <- tcRecordField con_like flds_w_tys f rhs ; case mb of Nothing -> return Nothing @@ -1444,7 +1444,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds tcRecordField :: ConLike -> Assoc Name Type -> LFieldOcc GhcRn -> LHsExpr GhcRn -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)) -tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs +tcRecordField con_like flds_w_tys (L loc (FieldOcc (Box sel_name) lbl)) rhs | Just field_ty <- assocMaybe flds_w_tys sel_name = addErrCtxt (fieldCtxt field_lbl) $ do { rhs' <- tcCheckPolyExprNC rhs field_ty @@ -1506,7 +1506,7 @@ checkMissingFields con_like rbinds field_strs = conLikeImplBangs con_like - fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds + fl `elemField` flds = any (\ fl' -> flSelector fl == unBox fl') flds {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1142,7 +1142,7 @@ tcConArgs con_like arg_tys penv con_args thing_inside = case con_args of tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn)) (LHsRecField GhcTc (LPat GhcTc)) tc_field penv - (L l (HsRecField (L loc (FieldOcc sel (L lr rdr))) pat pun)) + (L l (HsRecField (L loc (FieldOcc (Box sel) (L lr rdr))) pat pun)) thing_inside = do { sel' <- tcLookupId sel ; pat_ty <- setSrcSpan loc $ find_field_ty sel ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -904,7 +904,7 @@ mkOneRecordSelector all_cons idDetails fl rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField { hsRecFieldLbl - = L loc (FieldOcc sel_name + = L loc (FieldOcc (Box sel_name) (L loc $ mkVarUnqual lbl)) , hsRecFieldArg = L loc (VarPat noExtField (L loc field_var)) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -7,6 +7,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -130,6 +131,9 @@ module GHC.Utils.Misc ( -- * Utils for flags OverridingBool(..), overrideWith, + + -- * Box + Box(Box, unBox), ) where #include "HsVersions.h" @@ -166,7 +170,7 @@ import qualified Data.Set as Set import Data.Time #if defined(DEBUG) -import {-# SOURCE #-} GHC.Utils.Outputable ( text ) +import {-# SOURCE #-} GHC.Utils.Outputable ( Outputable(ppr), text ) import {-# SOURCE #-} GHC.Driver.Ppr ( warnPprTrace ) #endif @@ -1476,3 +1480,12 @@ overrideWith :: Bool -> OverridingBool -> Bool overrideWith b Auto = b overrideWith _ Always = True overrideWith _ Never = False + +-- A wrapper to make a strict field into a lazy one. +data Box a = Box { unBox :: a } + deriving (Eq, Ord, Data) + +instance Show a => Show (Box a) where + showsPrec n (Box a) = showsPrec n a + show (Box a) = show a + showList xs = showList (map unBox xs) ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -126,6 +126,7 @@ import qualified Data.List.NonEmpty as NEL import GHC.Fingerprint import GHC.Show ( showMultiLineString ) import GHC.Utils.Exception +import GHC.Utils.Misc (Box(Box)) import GHC.Exts (oneShot) {- @@ -859,6 +860,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable a => Outputable (Box a) where + ppr (Box a) = ppr a + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit a18c3af7f983f3b6d3cd84093c9079031da58468 +Subproject commit 7ec18458ab0d289fc5936bb632c2065a7c01db90 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67a0609b41284581700b1198c7a752c13a8738a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/67a0609b41284581700b1198c7a752c13a8738a4 You're receiving 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 30 16:19:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 12:19:47 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] gitlab-ci: Remove allow_failure from Windows jobs Message-ID: <5f74b0238710_80b3f8495fc6f8015649372@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 2773bcfd by Ben Gamari at 2020-09-30T12:18:16-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -809,8 +809,6 @@ validate-x86_64-linux-fedora27: ############################################################ .build-windows: - # For the reasons given in #17777 this build isn't reliable. - allow_failure: true before_script: - git clean -xdf @@ -977,8 +975,6 @@ doc-tarball: variables: LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" - # Due to Windows allow_failure - allow_failure: true artifacts: paths: - haddock.html.tar.xz View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2773bcfd71034ca31630cc3c76ce429245bb8b6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2773bcfd71034ca31630cc3c76ce429245bb8b6e You're receiving 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 30 16:21:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 12:21:21 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 45 commits: Update Lock.hs with more documentation to make sure that the Boolean return value is clear. Message-ID: <5f74b0811e0f9_80b732e3381564954b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - a16f060d by Ben Gamari at 2020-09-30T12:21:13-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Multiplicity.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Ppr.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Session.hs-boot - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Coverage.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2773bcfd71034ca31630cc3c76ce429245bb8b6e...a16f060d4278db2ce95c2582631786ebd1a854b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2773bcfd71034ca31630cc3c76ce429245bb8b6e...a16f060d4278db2ce95c2582631786ebd1a854b5 You're receiving 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 30 16:23:26 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 12:23:26 -0400 Subject: [Git][ghc/ghc][wip/strict-ttg] Fix test failures Message-ID: <5f74b0fead8e2_80bdb87718156513ee@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/strict-ttg at Glasgow Haskell Compiler / GHC Commits: e8b489ae by Vladislav Zavialov at 2020-09-30T19:23:04+03:00 Fix test failures - - - - - 14 changed files: - compiler/GHC/Hs/Expr.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/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2402,9 +2402,9 @@ pprStmt (LastStmt _ expr m_dollar_stripped _) Just False -> text "return" Nothing -> empty) <+> ppr expr -pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr] +pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds] -pprStmt (BodyStmt _ expr _ _) = ppr expr +pprStmt (BodyStmt _ expr _ _) = pprBodyStmt expr pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) pprStmt (TransStmt { trS_stmts = stmts, trS_by = by @@ -2439,10 +2439,9 @@ pprStmt (ApplicativeStmt _ args mb_join) flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc] flattenArg (_, ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL))] + [pprBodyStmt expr] | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))] + [pprBindStmt pat expr] flattenArg (_, ApplicativeArgMany _ stmts _ _ _) = concatMap flattenStmt stmts @@ -2456,6 +2455,11 @@ pprStmt (ApplicativeStmt _ args mb_join) pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc pp_arg (_, applicativeArg) = ppr applicativeArg +pprBodyStmt :: Outputable expr => expr -> SDoc +pprBodyStmt expr = ppr expr + +pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc +pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr] instance (OutputableBndrId idL) => Outputable (ApplicativeArg (GhcPass idL)) where @@ -2464,17 +2468,14 @@ instance (OutputableBndrId idL) pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc pprArg (ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL)) + pprBodyStmt expr | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL)) + pprBindStmt pat expr pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> - ppr (HsDo (panic "pprStmt") ctxt (noLoc - (stmts ++ - [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])) - :: HsExpr (GhcPass idL)) + pprDo ctxt (stmts ++ + [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -102,7 +102,7 @@ import GHC.Types.Basic import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Data.FastString -import GHC.Utils.Misc ( count ) +import GHC.Utils.Misc ( count, Box ) import Data.Data hiding ( Fixity, Prefix, Infix ) import Data.Maybe @@ -1690,7 +1690,8 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: !(XCFieldOcc pass) deriving instance Eq (XCFieldOcc (GhcPass p)) => Eq (FieldOcc (GhcPass p)) type instance XCFieldOcc GhcPs = NoExtField -type instance XCFieldOcc GhcRn = Name +type instance XCFieldOcc GhcRn = Box Name -- the Box is needed due to 'expectJust' in 'rnField' + -- TODO: refactor to remove it type instance XCFieldOcc GhcTc = Id type instance XXFieldOcc (GhcPass _) = NoExtCon ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1135,7 +1135,7 @@ hsTyClForeignBinders tycl_decls foreign_decls foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls) where getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name] - getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs + getSelectorNames (ns, fs) = map unLoc ns ++ map (unBox . extFieldOcc . unLoc) fs ------------------- hsLTyClDeclBinders :: IsPass p ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Tc.Types +import GHC.Utils.Misc (unBox) import Control.Applicative import Data.Bifunctor (first) @@ -188,7 +189,7 @@ subordinates instMap decl = case decl of , maybeToList $ fmap unLoc $ con_doc c , conArgDocs c) | c <- cons, cname <- getConNames c ] - fields = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty) + fields = [ (unBox (extFieldOcc n), maybeToList $ fmap unLoc doc, M.empty) | RecCon flds <- map getConArgs cons , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1633,7 +1633,7 @@ repFields (HsRecFields { rec_flds = flds }) where rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.FieldExp)) - rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { fn <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; e <- repLE (hsRecFieldArg fld) ; repFieldExp fn e } @@ -1992,7 +1992,7 @@ repP (ConPat NoExtField dc details) } where rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat))) - rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { MkC v <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; MkC p <- repLP (hsRecFieldArg fld) ; rep2 fieldPatName [v,p] } @@ -2626,7 +2626,7 @@ repConstr (RecCon ips) resTy cons rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip) rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType)) - rep_one_ip t n = do { MkC v <- lookupOcc (extFieldOcc $ unLoc n) + rep_one_ip t n = do { MkC v <- lookupOcc (unBox (extFieldOcc (unLoc n))) ; MkC ty <- repBangTy t ; rep2 varBangTypeName [v,ty] } ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -21,6 +21,7 @@ Main functions for .hie file generation module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where +import GHC.Utils.Misc (Box(Box)) import GHC.Utils.Outputable(ppr) import GHC.Prelude @@ -1278,7 +1279,7 @@ instance ( ToHie (RFContext (Located label)) instance ToHie (RFContext (Located (FieldOcc GhcRn))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc name _ -> + FieldOcc (Box name) _ -> [ toHie $ C (RecField c rhs) (L nspan name) ] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1174,7 +1174,7 @@ rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) where lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn lookupField (FieldOcc _ (L lr rdr)) = - FieldOcc (flSelector fl) (L lr rdr) + FieldOcc (Box (flSelector fl)) (L lr rdr) where lbl = occNameFS $ rdrNameOcc rdr fl = expectJust "rnField" $ lookupFsEnv fl_env lbl ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -654,7 +654,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) else return arg ; return (L l (HsRecField { hsRecFieldLbl = (L loc (FieldOcc - sel (L ll lbl))) + (Box sel) (L ll lbl))) , hsRecFieldArg = arg' , hsRecPun = pun })) } @@ -697,7 +697,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; addUsedGREs dot_dot_gres ; return [ L loc (HsRecField - { hsRecFieldLbl = L loc (FieldOcc sel (L loc arg_rdr)) + { hsRecFieldLbl = L loc (FieldOcc (Box sel) (L loc arg_rdr)) , hsRecFieldArg = L loc (mk_arg loc arg_rdr) , hsRecPun = False }) | fl <- dot_dot_fields @@ -792,7 +792,7 @@ rnHsRecUpdFields flds getFieldIds :: [LHsRecField GhcRn arg] -> [Name] -getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds +getFieldIds flds = map (unBox . unLoc . hsRecFieldSel . unLoc) flds getFieldLbls :: [LHsRecField id arg] -> [RdrName] getFieldLbls flds ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1429,7 +1429,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds , hsRecFieldArg = rhs })) = do { let lbl = rdrNameAmbiguousFieldOcc af sel_id = selectorAmbiguousFieldOcc af - f = L loc (FieldOcc (idName sel_id) (L loc lbl)) + f = L loc (FieldOcc (Box (idName sel_id)) (L loc lbl)) ; mb <- tcRecordField con_like flds_w_tys f rhs ; case mb of Nothing -> return Nothing @@ -1444,7 +1444,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds tcRecordField :: ConLike -> Assoc Name Type -> LFieldOcc GhcRn -> LHsExpr GhcRn -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)) -tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs +tcRecordField con_like flds_w_tys (L loc (FieldOcc (Box sel_name) lbl)) rhs | Just field_ty <- assocMaybe flds_w_tys sel_name = addErrCtxt (fieldCtxt field_lbl) $ do { rhs' <- tcCheckPolyExprNC rhs field_ty @@ -1506,7 +1506,7 @@ checkMissingFields con_like rbinds field_strs = conLikeImplBangs con_like - fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds + fl `elemField` flds = any (\ fl' -> flSelector fl == unBox fl') flds {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1142,7 +1142,7 @@ tcConArgs con_like arg_tys penv con_args thing_inside = case con_args of tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn)) (LHsRecField GhcTc (LPat GhcTc)) tc_field penv - (L l (HsRecField (L loc (FieldOcc sel (L lr rdr))) pat pun)) + (L l (HsRecField (L loc (FieldOcc (Box sel) (L lr rdr))) pat pun)) thing_inside = do { sel' <- tcLookupId sel ; pat_ty <- setSrcSpan loc $ find_field_ty sel ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -904,7 +904,7 @@ mkOneRecordSelector all_cons idDetails fl rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField { hsRecFieldLbl - = L loc (FieldOcc sel_name + = L loc (FieldOcc (Box sel_name) (L loc $ mkVarUnqual lbl)) , hsRecFieldArg = L loc (VarPat noExtField (L loc field_var)) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -7,6 +7,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -130,6 +131,9 @@ module GHC.Utils.Misc ( -- * Utils for flags OverridingBool(..), overrideWith, + + -- * Box + Box(Box, unBox), ) where #include "HsVersions.h" @@ -1476,3 +1480,12 @@ overrideWith :: Bool -> OverridingBool -> Bool overrideWith b Auto = b overrideWith _ Always = True overrideWith _ Never = False + +-- A wrapper to make a strict field into a lazy one. +data Box a = Box { unBox :: a } + deriving (Eq, Ord, Data) + +instance Show a => Show (Box a) where + showsPrec n (Box a) = showsPrec n a + show (Box a) = show a + showList xs = showList (map unBox xs) ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -126,6 +126,7 @@ import qualified Data.List.NonEmpty as NEL import GHC.Fingerprint import GHC.Show ( showMultiLineString ) import GHC.Utils.Exception +import GHC.Utils.Misc (Box(Box)) import GHC.Exts (oneShot) {- @@ -859,6 +860,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable a => Outputable (Box a) where + ppr (Box a) = ppr a + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit a18c3af7f983f3b6d3cd84093c9079031da58468 +Subproject commit 7ec18458ab0d289fc5936bb632c2065a7c01db90 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b489ae36d944bfe1f57c1242005f34d83cf5ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8b489ae36d944bfe1f57c1242005f34d83cf5ba You're receiving 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 30 16:36:08 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 12:36:08 -0400 Subject: [Git][ghc/ghc][wip/T18154] Don't attach CPR signatures to NOINLINE data structures (#18154) Message-ID: <5f74b3f8923d1_80b3f848c29bd7815657171@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18154 at Glasgow Haskell Compiler / GHC Commits: 68269955 by Sebastian Graf at 2020-09-30T18:36:01+02:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - 2 changed files: - compiler/GHC/Core/Opt/CprAnal.hs - testsuite/tests/simplCore/should_compile/T7360.stderr Changes: ===================================== compiler/GHC/Core/Opt/CprAnal.hs ===================================== @@ -118,9 +118,9 @@ cprAnalTopBind :: AnalEnv -> CoreBind -> (AnalEnv, CoreBind) cprAnalTopBind env (NonRec id rhs) - = (extendAnalEnv env id' (idCprInfo id'), NonRec id' rhs') + = (env', NonRec id' rhs') where - (id', rhs') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind TopLevel env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') @@ -178,7 +178,7 @@ cprAnal' env (Lam var body) | otherwise = (lam_ty, Lam var body') where - env' = extendAnalEnvForDemand env var (idDemandInfo var) + env' = extendSigEnvForDemand env var (idDemandInfo var) (body_ty, body') = cprAnal env' body lam_ty = abstractCprTy body_ty @@ -194,9 +194,8 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs') = cprAnalBind NotTopLevel env id rhs - env' = extendAnalEnv env id' (idCprInfo id') - (body_ty, body') = cprAnal env' body + (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') @@ -233,15 +232,15 @@ cprTransform env id sig where sig - -- See Note [CPR for expandable unfoldings] - | Just rhs <- cprExpandUnfolding_maybe id + -- Top-level binding, local let-binding or case binder + | Just sig <- lookupSigEnv env id + = getCprSig sig + -- See Note [CPR for data structures] + | Just rhs <- cprDataStructureUnfolding_maybe id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id = getCprSig (idCprInfo id) - -- Local let-bound - | Just sig <- lookupSigEnv env id - = getCprSig sig | otherwise = topCprType @@ -251,46 +250,43 @@ cprTransform env id -- Recursive bindings cprFix :: TopLevelFlag - -> AnalEnv -- Does not include bindings for this binding + -> AnalEnv -- Does not include bindings for this binding -> [(Id,CoreExpr)] - -> (AnalEnv, [(Id,CoreExpr)]) -- Binders annotated with stricness info - -cprFix top_lvl env orig_pairs - = loop 1 initial_pairs + -> (AnalEnv, [(Id,CoreExpr)]) -- Binders annotated with CPR info +cprFix top_lvl orig_env orig_pairs + = loop 1 init_env init_pairs where - bot_sig = mkCprSig 0 botCpr + init_sig id rhs + -- See Note [CPR for data structures] + | isDataStructure id rhs = topCprSig + | otherwise = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal - initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] - | otherwise = orig_pairs - - -- The fixed-point varies the idCprInfo field of the binders, and terminates if that - -- annotation does not change any more. - loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) - loop n pairs - | found_fixpoint = (final_anal_env, pairs') - | otherwise = loop (n+1) pairs' - where - found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs - first_round = n == 1 - pairs' = step first_round pairs - final_anal_env = extendAnalEnvs env (map fst pairs') - - step :: Bool -> [(Id, CoreExpr)] -> [(Id, CoreExpr)] - step first_round pairs = pairs' + orig_virgin = ae_virgin orig_env + init_pairs | orig_virgin = [(setIdCprInfo id (init_sig id rhs), rhs) | (id, rhs) <- orig_pairs ] + | otherwise = orig_pairs + init_env = extendSigEnvList orig_env (map fst init_pairs) + + -- The fixed-point varies the idCprInfo field of the binders and and their + -- entries in the AnalEnv, and terminates if that annotation does not change + -- any more. + loop :: Int -> AnalEnv -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) + loop n env pairs + | found_fixpoint = (reset_env', pairs') + | otherwise = loop (n+1) env' pairs' where -- In all but the first iteration, delete the virgin flag - start_env | first_round = env - | otherwise = nonVirgin env - - start = extendAnalEnvs start_env (map fst pairs) - - (_, pairs') = mapAccumL my_downRhs start pairs - - my_downRhs env (id,rhs) - = (env', (id', rhs')) + -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal + (env', pairs') = step (applyWhen (n/=1) nonVirgin env) pairs + -- Make sure we reset the virgin flag to what it was when we are stable + reset_env' = env'{ ae_virgin = orig_virgin } + found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs + + step :: AnalEnv -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) + step env pairs = mapAccumL go env pairs + where + go env (id, rhs) = (env', (id', rhs')) where - (id', rhs') = cprAnalBind top_lvl env id rhs - env' = extendAnalEnv env id (idCprInfo id') + (id', rhs', env') = cprAnalBind top_lvl env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. @@ -299,9 +295,13 @@ cprAnalBind -> AnalEnv -> Id -> CoreExpr - -> (Id, CoreExpr) + -> (Id, CoreExpr, AnalEnv) cprAnalBind top_lvl env id rhs - = (id', rhs') + -- See Note [CPR for data structures] + | isDataStructure id rhs + = (id, rhs, env) -- Data structure => no code => need to analyse rhs + | otherwise + = (id', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info @@ -310,12 +310,11 @@ cprAnalBind top_lvl env id rhs | stays_thunk = trimCprTy rhs_ty -- See Note [CPR for sum types] | returns_sum = trimCprTy rhs_ty - -- See Note [CPR for expandable unfoldings] - | will_expand = topCprType | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] - sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + sig = mkCprSigForArity (idArity id) rhs_ty' + id' = setIdCprInfo id sig + env' = extendSigEnv env id sig -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict @@ -325,15 +324,22 @@ cprAnalBind top_lvl env id rhs (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) returns_sum = not (isTopLevel top_lvl) && not_a_prod - -- See Note [CPR for expandable unfoldings] - will_expand = isJust (cprExpandUnfolding_maybe id) -cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr -cprExpandUnfolding_maybe id = do - guard (idArity id == 0) +isDataStructure :: Id -> CoreExpr -> Bool +-- See Note [CPR for data structures] +isDataStructure id rhs = + idArity id == 0 && exprIsHNF rhs + +-- | Returns an expandable unfolding +-- (See Note [exprIsExpandable] in "GHC.Core.Utils") that has +-- So effectively is a constructor application. +cprDataStructureUnfolding_maybe :: Id -> Maybe CoreExpr +cprDataStructureUnfolding_maybe id = do -- There are only FinalPhase Simplifier runs after CPR analysis guard (activeInFinalPhase (idInlineActivation id)) - expandUnfolding_maybe (idUnfolding id) + unf <- expandUnfolding_maybe (idUnfolding id) + guard (isDataStructure id unf) + return unf {- Note [Arity trimming for CPR signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -394,15 +400,15 @@ emptyAnalEnv fam_envs , ae_fam_envs = fam_envs } --- | Extend an environment with the strictness IDs attached to the id -extendAnalEnvs :: AnalEnv -> [Id] -> AnalEnv -extendAnalEnvs env ids +-- | Extend an environment with the CPR sigs attached to the id +extendSigEnvList :: AnalEnv -> [Id] -> AnalEnv +extendSigEnvList env ids = env { ae_sigs = sigs' } where sigs' = extendVarEnvList (ae_sigs env) [ (id, idCprInfo id) | id <- ids ] -extendAnalEnv :: AnalEnv -> Id -> CprSig -> AnalEnv -extendAnalEnv env id sig +extendSigEnv :: AnalEnv -> Id -> CprSig -> AnalEnv +extendSigEnv env id sig = env { ae_sigs = extendVarEnv (ae_sigs env) id sig } lookupSigEnv :: AnalEnv -> Id -> Maybe CprSig @@ -411,17 +417,17 @@ lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv nonVirgin env = env { ae_virgin = False } --- | A version of 'extendAnalEnv' for a binder of which we don't see the RHS +-- | A version of 'extendSigEnv' for a binder of which we don't see the RHS -- needed to compute a 'CprSig' (e.g. lambdas and DataAlt field binders). -- In this case, we can still look at their demand to attach CPR signatures -- anticipating the unboxing done by worker/wrapper. -- See Note [CPR for binders that will be unboxed]. -extendAnalEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv -extendAnalEnvForDemand env id dmd +extendSigEnvForDemand :: AnalEnv -> Id -> Demand -> AnalEnv +extendSigEnvForDemand env id dmd | isId id , Just (_, DataConAppContext { dcac_dc = dc }) <- wantToUnbox (ae_fam_envs env) has_inlineable_prag (idType id) dmd - = extendAnalEnv env id (CprSig (conCprType (dataConTag dc))) + = extendSigEnv env id (CprSig (conCprType (dataConTag dc))) | otherwise = env where @@ -436,7 +442,7 @@ extendEnvForDataAlt :: AnalEnv -> CoreExpr -> Id -> DataCon -> [Var] -> AnalEnv extendEnvForDataAlt env scrut case_bndr dc bndrs = foldl' do_con_arg env' ids_w_strs where - env' = extendAnalEnv env case_bndr (CprSig case_bndr_ty) + env' = extendSigEnv env case_bndr (CprSig case_bndr_ty) ids_w_strs = filter isId bndrs `zip` dataConRepStrictness dc @@ -460,7 +466,7 @@ extendEnvForDataAlt env scrut case_bndr dc bndrs | is_var scrut -- See Note [Add demands for strict constructors] in GHC.Core.Opt.WorkWrap.Utils , let dmd = applyWhen (isMarkedStrict str) strictifyDmd (idDemandInfo id) - = extendAnalEnvForDemand env id dmd + = extendSigEnvForDemand env id dmd | otherwise = env @@ -645,46 +651,72 @@ assumption is that error cases are rarely entered and we are diverging anyway, so WW doesn't hurt. Should we also trim CPR on DataCon application bindings? -See Note [CPR for expandable unfoldings]! +See Note [CPR for data structures]! -Note [CPR for expandable unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [CPR for data structures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 +should not get CPR signatures (#18154), 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! + Reason: the CPR info for xs1 contains the CPR info for xs; the CPR info + for xs2 contains that for xs1. And so on. + +Hence we don't analyse or annotate data structures in 'cprAnalBind'. To +implement this, the isDataStructure guard is triggered for bindings that satisfy -But we can't just stop giving DataCon application bindings the CPR property, + (1) idArity id == 0 (otherwise it's a function) + (2) exprIsHNF rhs (otherwise it's a thunk, Note [CPR for thunks] applies) + +But we can't just stop giving DataCon application bindings the CPR *property*, for example - fac 0 = 1 + fac 0 = I# 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 + lvl = I# 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'. +If lvl doesn't have the CPR property, fac won't either. But lvl is a data +structure, and hence (see above) will not have a CPR signature. So instead, when +'cprAnal' meets a variable lacking a CPR signature to extrapolate into a CPR +transformer, 'cprTransform' instead tries to get its unfolding (via +'cprDataStructureUnfolding_maybe'), and analyses that instead. 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). - -Tracked by #18154. +for each data declaration. They should not have CPR signatures (blow up!). + +There is a perhaps surprising special case: KindRep bindings satisfy +'isDataStructure' (so no CPR signature), but are marked NOINLINE at the same +time (see the noinline wrinkle in Note [Grand plan for Typeable]). So there is +no unfolding for 'cprDataStructureUnfolding_maybe' to look through and we'll +return topCprType. And that is fine! We should refrain to look through NOINLINE +data structures in general, as a constructed product could never be exposed +after WW. + +It's also worth pointing out how ad-hoc this is: If we instead had + + f1 x = x:[] + f2 x = x : f1 x + f3 x = x : f2 x + ... + +we still give every function an every deepening CPR signature. But it's very +uncommon to find code like this, whereas the long static data structures from +the beginning of this Note are very common because of GHC's strategy of ANF'ing +data structure RHSs. Note [CPR examples] ~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/simplCore/should_compile/T7360.stderr ===================================== @@ -92,7 +92,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep) @@ -127,7 +127,7 @@ T7360.$tcFoo -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m1, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep) @@ -190,7 +190,7 @@ T7360.$tc'Foo2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep -[GblId, Cpr=m4, Unf=OtherCon []] +[GblId, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68269955309746c8a48c8f7944fc0242dbe93d13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68269955309746c8a48c8f7944fc0242dbe93d13 You're receiving 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 30 16:41:22 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 12:41:22 -0400 Subject: [Git][ghc/ghc][wip/T18765] s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) Message-ID: <5f74b532cecef_80b3f847c5e32341565774a@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18765 at Glasgow Haskell Compiler / GHC Commits: ca238a08 by Sebastian Graf at 2020-09-30T18:37:48+02:00 s/NOINLINE/NOINLINE[0]/g in GHC.Num.Integer (#18765) This defeats constant-folding in the final phases of the Simplifier, but enables us to get rid of allocations by inlining calls that can't be constant-folded. `NOINLINE[0]` is a better choice than `NOINLINE`, because 1. We still delay inlining long enough for the constant-folding RULEs to fire 2. The compiler has the option to inlining them late, possibly cancelling away boxes in the process. `NOINLINE[0]` is a better choice than `INLINE[0]`, because 3. We don't unconditionally inline huge definitions such as `integerDiv`, which would lead to code bloat at pretty much no gain. 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. `integerDiv`, there is no gain in inlining the unoptimised unfoldings. We also have to mark all callers that want to participate in constant folding as `INLINE`. See the new `Note [Integer constant folding]` for details. I had to change the `Num.fromInteger` and `Integral.toInteger` implementations of `Int*` and `Word*` variants to call the constant folded `integerToInt*#` and `integerToWord*#` variants directly to ensure constant folding. Fixes #18765. Metric Decrease: T10359 - - - - - 7 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/GHC/Word.hs - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1347,7 +1347,7 @@ builtinBignumRules _ = , rule_shift_op "integerShiftL" integerShiftLName shiftL , rule_shift_op "integerShiftR" integerShiftRName shiftR , rule_integerBit "integerBit" integerBitName - -- See Note [Integer division constant folding] in libraries/base/GHC/Real.hs + -- See Note [Integer constant folding] in "GHC.Num.Integer" , rule_divop_one "integerQuot" integerQuotName quot , rule_divop_one "integerRem" integerRemName rem , rule_divop_one "integerDiv" integerDivName div ===================================== libraries/base/GHC/Float.hs ===================================== @@ -494,6 +494,7 @@ instance Num Double where -- | @since 2.01 instance Real Double where + {-# INLINE toRational #-} -- See Note [Integer constant folding] toRational (D# x#) = case integerDecodeDouble# x# of (# m, e# #) @@ -580,11 +581,7 @@ instance Floating Double where -- | @since 2.01 instance RealFrac Double where - -- ceiling, floor, and truncate are all small - {-# INLINE [1] ceiling #-} - {-# INLINE [1] floor #-} - {-# INLINE [1] truncate #-} - + {-# INLINE properFraction #-} -- See Note [Integer constant folding] properFraction x = case (decodeFloat x) of { (m,n) -> if n >= 0 then @@ -595,9 +592,11 @@ instance RealFrac Double where } } + {-# INLINE truncate #-} -- See Note [Integer constant folding] truncate x = case properFraction x of (n,_) -> n + {-# INLINE round #-} -- See Note [Integer constant folding] round x = case properFraction x of (n,r) -> let m = if r < 0.0 then n - 1 else n + 1 @@ -608,9 +607,11 @@ instance RealFrac Double where EQ -> if even n then n else m GT -> m + {-# INLINE ceiling #-} -- See Note [Integer constant folding] ceiling x = case properFraction x of (n,r) -> if r > 0.0 then n + 1 else n + {-# INLINE floor #-} -- See Note [Integer constant folding] floor x = case properFraction x of (n,r) -> if r < 0.0 then n - 1 else n @@ -620,18 +621,23 @@ instance RealFloat Double where floatDigits _ = DBL_MANT_DIG -- ditto floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto + {-# INLINE decodeFloat #-} -- See Note [Integer constant folding] decodeFloat (D# x#) = case integerDecodeDouble# x# of (# i, j #) -> (i, I# j) + {-# INLINE encodeFloat #-} -- See Note [Integer constant folding] encodeFloat i (I# j) = D# (integerEncodeDouble# i j) + {-# INLINE exponent #-} -- See Note [Integer constant folding] exponent x = case decodeFloat x of (m,n) -> if m == 0 then 0 else n + floatDigits x + {-# INLINE significand #-} -- See Note [Integer constant folding] significand x = case decodeFloat x of (m,_) -> encodeFloat m (negate (floatDigits x)) + {-# INLINE scaleFloat #-} -- See Note [Integer constant folding] scaleFloat 0 x = x scaleFloat k x | isFix = x ===================================== libraries/base/GHC/Int.hs ===================================== @@ -106,6 +106,7 @@ instance Num Int8 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I8# (narrow8Int# (integerToInt# i)) -- | @since 2.01 @@ -160,7 +161,8 @@ instance Integral Int8 where (# d, m #) -> (I8# (narrow8Int# d), I8# (narrow8Int# m)) - toInteger (I8# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I8# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int8 where @@ -313,6 +315,7 @@ instance Num Int16 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I16# (narrow16Int# (integerToInt# i)) -- | @since 2.01 @@ -367,7 +370,8 @@ instance Integral Int16 where (# d, m #) -> (I16# (narrow16Int# d), I16# (narrow16Int# m)) - toInteger (I16# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I16# x) = integerFromInt64# x -- | @since 2.01 instance Bounded Int16 where @@ -525,6 +529,7 @@ instance Num Int32 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I32# (narrow32Int# (integerToInt# i)) -- | @since 2.01 @@ -587,7 +592,8 @@ instance Integral Int32 where (# d, m #) -> (I32# (narrow32Int# d), I32# (narrow32Int# m)) - toInteger (I32# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I32# x) = integerFromInt64# x -- | @since 2.01 instance Read Int32 where @@ -748,6 +754,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt64# i) -- | @since 2.01 @@ -804,6 +811,7 @@ instance Integral Int64 where | y == (-1) && x == minBound = (overflowError, 0) | otherwise = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#)) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (I64# x) = integerFromInt64# x @@ -953,6 +961,7 @@ instance Num Int64 where signum x | x > 0 = 1 signum 0 = 0 signum _ = -1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = I64# (integerToInt# i) -- | @since 2.01 @@ -1006,7 +1015,8 @@ instance Integral Int64 where | otherwise = case x# `divModInt#` y# of (# d, m #) -> (I64# d, I64# m) - toInteger (I64# x#) = IS x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I64# x) = integerFromInt64# x -- | @since 2.01 instance Read Int64 where ===================================== libraries/base/GHC/Num.hs ===================================== @@ -109,7 +109,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 - {-# INLINE fromInteger #-} -- Just to be sure! + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToInt i -- | @since 2.01 @@ -121,6 +121,7 @@ instance Num Word where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = integerToWord i -- | @since 2.01 @@ -150,6 +151,7 @@ instance Num Natural where | naturalIsZero x = x | otherwise = raise# underflowException + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger x | x < 0 = raise# underflowException | otherwise = integerToNaturalClamp x @@ -160,4 +162,3 @@ instance Num Natural where {-# DEPRECATED quotRemInteger "Use integerQuotRem# instead" #-} quotRemInteger :: Integer -> Integer -> (# Integer, Integer #) quotRemInteger = integerQuotRem# - ===================================== libraries/base/GHC/Real.hs ===================================== @@ -324,7 +324,8 @@ instance Real Int where -- | @since 2.0.1 instance Integral Int where - toInteger (I# i) = IS i + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (I# x) = integerFromInt# x a `quot` b | b == 0 = divZeroError @@ -399,6 +400,7 @@ instance Integral Word where divMod (W# x#) y@(W# y#) | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W# x#) = integerFromWord# x# -------------------------------------------------------------- @@ -413,71 +415,60 @@ instance Real Integer where instance Real Natural where toRational n = integerFromNatural n :% 1 --- Note [Integer division constant folding] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Constant folding of quot, rem, div, mod, divMod and quotRem for Integer --- arguments depends crucially on inlining. Constant folding rules defined in --- GHC.Core.Opt.ConstantFold trigger for integerQuot, integerRem and so on. --- So if calls to quot, rem and so on were not inlined the rules would not fire. --- --- The rules would also not fire if calls to integerQuot and so on were inlined, --- but this does not happen because they are all marked with NOINLINE pragma. - - -- | @since 2.0.1 instance Integral Integer where toInteger n = n - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `integerQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `integerRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `integerDiv` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `integerMod` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `integerDivMod` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `integerQuotRem` d -- | @since 4.8.0.0 instance Integral Natural where + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger = integerFromNatural - {-# INLINE quot #-} + {-# INLINE quot #-} -- See Note [Integer constant folding] _ `quot` 0 = divZeroError n `quot` d = n `naturalQuot` d - {-# INLINE rem #-} + {-# INLINE rem #-} -- See Note [Integer constant folding] _ `rem` 0 = divZeroError n `rem` d = n `naturalRem` d - {-# INLINE div #-} + {-# INLINE div #-} -- See Note [Integer constant folding] _ `div` 0 = divZeroError n `div` d = n `naturalQuot` d - {-# INLINE mod #-} + {-# INLINE mod #-} -- See Note [Integer constant folding] _ `mod` 0 = divZeroError n `mod` d = n `naturalRem` d - {-# INLINE divMod #-} + {-# INLINE divMod #-} -- See Note [Integer constant folding] _ `divMod` 0 = divZeroError n `divMod` d = n `naturalQuotRem` d - {-# INLINE quotRem #-} + {-# INLINE quotRem #-} -- See Note [Integer constant folding] _ `quotRem` 0 = divZeroError n `quotRem` d = n `naturalQuotRem` d ===================================== libraries/base/GHC/Word.hs ===================================== @@ -112,6 +112,7 @@ instance Num Word8 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W8# (narrow8Word# (integerToWord# i)) -- | @since 2.01 @@ -156,7 +157,8 @@ instance Integral Word8 where divMod (W8# x#) y@(W8# y#) | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W8# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W8# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word8 where @@ -303,6 +305,7 @@ instance Num Word16 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W16# (narrow16Word# (integerToWord# i)) -- | @since 2.01 @@ -347,7 +350,8 @@ instance Integral Word16 where divMod (W16# x#) y@(W16# y#) | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W16# x#) = IS (word2Int# x#) + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W16# x#) = integerFromWord# x# -- | @since 2.01 instance Bounded Word16 where @@ -533,6 +537,7 @@ instance Num Word32 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W32# (narrow32Word# (integerToWord# i)) -- | @since 2.01 @@ -587,15 +592,8 @@ instance Integral Word32 where divMod (W32# x#) y@(W32# y#) | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W32# x#) -#if WORD_SIZE_IN_BITS == 32 - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# -#else - = IS (word2Int# x#) -#endif + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W32# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word32 where @@ -728,6 +726,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord64# i) -- | @since 2.01 @@ -770,6 +769,7 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#)) | otherwise = divZeroError + {-# INLINE toInteger #-} -- See Note [Integer constant folding] toInteger (W64# x#) = integerFromWord64# x# -- | @since 2.01 @@ -875,6 +875,7 @@ instance Num Word64 where abs x = x signum 0 = 0 signum _ = 1 + {-# INLINE fromInteger #-} -- See Note [Integer constant folding] fromInteger i = W64# (integerToWord# i) -- | @since 2.01 @@ -953,11 +954,8 @@ instance Integral Word64 where divMod (W64# x#) y@(W64# y#) | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#)) | otherwise = divZeroError - toInteger (W64# x#) - | isTrue# (i# >=# 0#) = IS i# - | otherwise = integerFromWord# x# - where - !i# = word2Int# x# + {-# INLINE toInteger #-} -- See Note [Integer constant folding] + toInteger (W64# x#) = integerFromWord# x# -- | @since 2.01 instance Bits Word64 where ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -66,6 +66,7 @@ integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND -- | Check Integer invariants integerCheck :: Integer -> Bool +{-# INLINE integerCheck #-} integerCheck i = isTrue# (integerCheck# i) -- | Integer Zero @@ -137,6 +138,7 @@ integerToBigNatClamp# _ = bigNatZero# (# #) -- | Create an Integer from an Int# integerFromInt# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt# #-} -- See Note [Integer constant folding] integerFromInt# i = IS i -- | Create an Integer from an Int @@ -145,18 +147,19 @@ integerFromInt (I# i) = IS i -- | Truncates 'Integer' to least-significant 'Int#' integerToInt# :: Integer -> Int# -{-# NOINLINE integerToInt# #-} +{-# NOINLINE[0] integerToInt# #-} -- See Note [Integer constant folding] integerToInt# (IS i) = i integerToInt# (IP b) = word2Int# (bigNatToWord# b) integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) -- | Truncates 'Integer' to least-significant 'Int#' integerToInt :: Integer -> Int +{-# INLINE integerToInt #-} -- See Note [Integer constant folding] integerToInt i = I# (integerToInt# i) -- | Convert a Word# into an Integer integerFromWord# :: Word# -> Integer -{-# NOINLINE integerFromWord# #-} +{-# NOINLINE[0] integerFromWord# #-} -- See Note [Integer constant folding] integerFromWord# w | i <- word2Int# w , isTrue# (i >=# 0#) @@ -167,6 +170,7 @@ integerFromWord# w -- | Convert a Word into an Integer integerFromWord :: Word -> Integer +{-# INLINE integerFromWord #-} -- See Note [Integer constant folding] integerFromWord (W# w) = integerFromWord# w -- | Create a negative Integer with the given Word magnitude @@ -185,23 +189,25 @@ integerFromWordSign# _ w = integerFromWordNeg# w -- | Truncate an Integer into a Word integerToWord# :: Integer -> Word# -{-# NOINLINE integerToWord# #-} +{-# NOINLINE[0] integerToWord# #-} -- See Note [Integer constant folding] integerToWord# (IS i) = int2Word# i integerToWord# (IP bn) = bigNatToWord# bn integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) -- | Truncate an Integer into a Word integerToWord :: Integer -> Word +{-# INLINE integerToWord #-} -- See Note [Integer constant folding] integerToWord !i = W# (integerToWord# i) -- | Convert a Natural into an Integer integerFromNatural :: Natural -> Integer -{-# NOINLINE integerFromNatural #-} +{-# NOINLINE[0] integerFromNatural #-} -- See Note [Integer constant folding] integerFromNatural (NS x) = integerFromWord# x integerFromNatural (NB x) = integerFromBigNat# x -- | Convert a list of Word into an Integer integerFromWordList :: Bool -> [Word] -> Integer +{-# INLINE integerFromWordList #-} -- See Note [Integer constant folding] integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) @@ -209,7 +215,7 @@ integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) -- -- Return 0 for negative Integers. integerToNaturalClamp :: Integer -> Natural -{-# NOINLINE integerToNaturalClamp #-} +{-# NOINLINE[0] integerToNaturalClamp #-} -- See Note [Integer constant folding] integerToNaturalClamp (IS x) | isTrue# (x <# 0#) = naturalZero | True = naturalFromWord# (int2Word# x) @@ -220,7 +226,7 @@ integerToNaturalClamp (IN _) = naturalZero -- -- Return absolute value integerToNatural :: Integer -> Natural -{-# NOINLINE integerToNatural #-} +{-# NOINLINE[0] integerToNatural #-} -- See Note [Integer constant folding] integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) integerToNatural (IP x) = naturalFromBigNat# x integerToNatural (IN x) = naturalFromBigNat# x @@ -237,40 +243,50 @@ integerIsNegative# (IN _) = 1# -- | Negative predicate integerIsNegative :: Integer -> Bool +{-# INLINE integerIsNegative #-} -- See Note [Integer constant folding] integerIsNegative !i = isTrue# (integerIsNegative# i) -- | Zero predicate integerIsZero :: Integer -> Bool +{-# INLINE integerIsZero #-} -- See Note [Integer constant folding] integerIsZero (IS 0#) = True integerIsZero _ = False -- | Not-equal predicate. integerNe :: Integer -> Integer -> Bool +{-# INLINE integerNe #-} -- See Note [Integer constant folding] integerNe !x !y = isTrue# (integerNe# x y) -- | Equal predicate. integerEq :: Integer -> Integer -> Bool +{-# INLINE integerEq #-} -- See Note [Integer constant folding] integerEq !x !y = isTrue# (integerEq# x y) -- | Lower-or-equal predicate. integerLe :: Integer -> Integer -> Bool +{-# INLINE integerLe #-} -- See Note [Integer constant folding] integerLe !x !y = isTrue# (integerLe# x y) -- | Lower predicate. integerLt :: Integer -> Integer -> Bool +{-# INLINE integerLt #-} -- See Note [Integer constant folding] integerLt !x !y = isTrue# (integerLt# x y) -- | Greater predicate. integerGt :: Integer -> Integer -> Bool +{-# INLINE integerGt #-} -- See Note [Integer constant folding] integerGt !x !y = isTrue# (integerGt# x y) -- | Greater-or-equal predicate. integerGe :: Integer -> Integer -> Bool +{-# INLINE integerGe #-} -- See Note [Integer constant folding] integerGe !x !y = isTrue# (integerGe# x y) -- | Equal predicate. integerEq# :: Integer -> Integer -> Bool# -{-# NOINLINE integerEq# #-} +{-# NOINLINE integerEq# #-} -- See Note [Integer constant folding] + -- But this function will be too huge if inlined + -- at all. Hence NOINLINE, without [0] integerEq# (IS x) (IS y) = x ==# y integerEq# (IN x) (IN y) = bigNatEq# x y integerEq# (IP x) (IP y) = bigNatEq# x y @@ -278,7 +294,9 @@ integerEq# _ _ = 0# -- | Not-equal predicate. integerNe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerNe# #-} +{-# NOINLINE integerNe# #-} -- See Note [Integer constant folding] + -- But this function will be too huge if inlined + -- at all. Hence NOINLINE, without [0] integerNe# (IS x) (IS y) = x /=# y integerNe# (IN x) (IN y) = bigNatNe# x y integerNe# (IP x) (IP y) = bigNatNe# x y @@ -286,39 +304,43 @@ integerNe# _ _ = 1# -- | Greater predicate. integerGt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGt# #-} +{-# NOINLINE[0] integerGt# #-} -- See Note [Integer constant folding] integerGt# (IS x) (IS y) = x ># y integerGt# x y | GT <- integerCompare x y = 1# integerGt# _ _ = 0# -- | Lower-or-equal predicate. integerLe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLe# #-} +{-# NOINLINE[0] integerLe# #-} -- See Note [Integer constant folding] integerLe# (IS x) (IS y) = x <=# y integerLe# x y | GT <- integerCompare x y = 0# integerLe# _ _ = 1# -- | Lower predicate. integerLt# :: Integer -> Integer -> Bool# -{-# NOINLINE integerLt# #-} +{-# NOINLINE[0] integerLt# #-} -- See Note [Integer constant folding] integerLt# (IS x) (IS y) = x <# y integerLt# x y | LT <- integerCompare x y = 1# integerLt# _ _ = 0# -- | Greater-or-equal predicate. integerGe# :: Integer -> Integer -> Bool# -{-# NOINLINE integerGe# #-} +{-# NOINLINE[0] integerGe# #-} -- See Note [Integer constant folding] integerGe# (IS x) (IS y) = x >=# y integerGe# x y | LT <- integerCompare x y = 0# integerGe# _ _ = 1# instance Eq Integer where + {-# INLINE (==) #-} -- See Note [Integer constant folding] (==) = integerEq + {-# INLINE (/=) #-} -- See Note [Integer constant folding] (/=) = integerNe -- | Compare two Integer integerCompare :: Integer -> Integer -> Ordering -{-# NOINLINE integerCompare #-} +{-# NOINLINE integerCompare #-} -- See Note [Integer constant folding] + -- But this function will be too huge if inlined + -- at all. Hence NOINLINE, without [0] integerCompare (IS x) (IS y) = compareInt# x y integerCompare (IP x) (IP y) = bigNatCompare x y integerCompare (IN x) (IN y) = bigNatCompare y x @@ -330,6 +352,7 @@ integerCompare (IP _) (IN _) = GT integerCompare (IN _) (IP _) = LT instance Ord Integer where + {-# INLINE compare #-} -- See Note [Integer constant folding] compare = integerCompare --------------------------------------------------------------------- @@ -338,7 +361,7 @@ instance Ord Integer where -- | Subtract one 'Integer' from another. integerSub :: Integer -> Integer -> Integer -{-# NOINLINE integerSub #-} +{-# NOINLINE[0] integerSub #-} -- See Note [Integer constant folding] integerSub !x (IS 0#) = x integerSub (IS x#) (IS y#) = case subIntC# x# y# of @@ -384,7 +407,7 @@ integerSub (IN x) (IS y#) -- | Add two 'Integer's integerAdd :: Integer -> Integer -> Integer -{-# NOINLINE integerAdd #-} +{-# NOINLINE[0] integerAdd #-} -- See Note [Integer constant folding] integerAdd !x (IS 0#) = x integerAdd (IS 0#) y = y integerAdd (IS x#) (IS y#) @@ -413,7 +436,7 @@ integerAdd (IP x) (IN y) -- | Multiply two 'Integer's integerMul :: Integer -> Integer -> Integer -{-# NOINLINE integerMul #-} +{-# NOINLINE[0] integerMul #-} -- See Note [Integer constant folding] integerMul !_ (IS 0#) = IS 0# integerMul (IS 0#) _ = IS 0# integerMul x (IS 1#) = x @@ -478,7 +501,7 @@ integerMul (IN x) (IS y) -- IP is used iff n > maxBound::Int -- IN is used iff n < minBound::Int integerNegate :: Integer -> Integer -{-# NOINLINE integerNegate #-} +{-# NOINLINE[0] integerNegate #-} -- See Note [Integer constant folding] integerNegate (IN b) = IP b integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) integerNegate (IS i) = IS (negateInt# i) @@ -489,7 +512,7 @@ integerNegate (IP b) -- | Compute absolute value of an 'Integer' integerAbs :: Integer -> Integer -{-# NOINLINE integerAbs #-} +{-# NOINLINE[0] integerAbs #-} -- See Note [Integer constant folding] integerAbs (IN i) = IP i integerAbs n@(IP _) = n integerAbs n@(IS i) @@ -501,13 +524,13 @@ integerAbs n@(IS i) -- | Return @-1@, @0@, and @1@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum :: Integer -> Integer -{-# NOINLINE integerSignum #-} +{-# NOINLINE[0] integerSignum #-} -- See Note [Integer constant folding] integerSignum !j = IS (integerSignum# j) -- | Return @-1#@, @0#@, and @1#@ depending on whether argument is -- negative, zero, or positive, respectively integerSignum# :: Integer -> Int# -{-# NOINLINE integerSignum# #-} +{-# NOINLINE[0] integerSignum# #-} -- See Note [Integer constant folding] integerSignum# (IN _) = -1# integerSignum# (IS i#) = sgnI# i# integerSignum# (IP _ ) = 1# @@ -515,7 +538,7 @@ integerSignum# (IP _ ) = 1# -- | Count number of set bits. For negative arguments returns -- the negated population count of the absolute value. integerPopCount# :: Integer -> Int# -{-# NOINLINE integerPopCount# #-} +{-# NOINLINE[0] integerPopCount# #-} -- See Note [Integer constant folding] integerPopCount# (IS i) | isTrue# (i >=# 0#) = word2Int# (popCntI# i) | True = negateInt# (word2Int# (popCntI# (negateInt# i))) @@ -524,7 +547,7 @@ integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) -- | Positive 'Integer' for which only /n/-th bit is set integerBit# :: Word# -> Integer -{-# NOINLINE integerBit# #-} +{-# NOINLINE[0] integerBit# #-} -- See Note [Integer constant folding] integerBit# i | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) = IS (uncheckedIShiftL# 1# (word2Int# i)) @@ -533,13 +556,14 @@ integerBit# i -- | 'Integer' for which only /n/-th bit is set integerBit :: Word -> Integer +{-# INLINE integerBit #-} -- See Note [Integer constant folding] integerBit (W# i) = integerBit# i -- | Test if /n/-th bit is set. -- -- Fake 2's complement for negative values (might be slow) integerTestBit# :: Integer -> Word# -> Bool# -{-# NOINLINE integerTestBit# #-} +{-# NOINLINE[0] integerTestBit# #-} -- See Note [Integer constant folding] integerTestBit# (IS x) i | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = testBitI# x i @@ -569,13 +593,14 @@ integerTestBit# (IN x) i -- -- Fake 2's complement for negative values (might be slow) integerTestBit :: Integer -> Word -> Bool +{-# INLINE integerTestBit #-} -- See Note [Integer constant folding] integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) -- | Shift-right operation -- -- Fake 2's complement for negative values (might be slow) integerShiftR# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftR# #-} +{-# NOINLINE[0] integerShiftR# #-} -- See Note [Integer constant folding] integerShiftR# !x 0## = x integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) where @@ -592,11 +617,12 @@ integerShiftR# (IN bn) n = -- -- Fake 2's complement for negative values (might be slow) integerShiftR :: Integer -> Word -> Integer +{-# INLINE integerShiftR #-} -- See Note [Integer constant folding] integerShiftR !x (W# w) = integerShiftR# x w -- | Shift-left operation integerShiftL# :: Integer -> Word# -> Integer -{-# NOINLINE integerShiftL# #-} +{-# NOINLINE[0] integerShiftL# #-} -- See Note [Integer constant folding] integerShiftL# !x 0## = x integerShiftL# (IS 0#) _ = IS 0# integerShiftL# (IS 1#) n = integerBit# n @@ -611,13 +637,14 @@ integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) -- Remember that bits are stored in sign-magnitude form, hence the behavior of -- negative Integers is different from negative Int's behavior. integerShiftL :: Integer -> Word -> Integer +{-# INLINE integerShiftL #-} -- See Note [Integer constant folding] integerShiftL !x (W# w) = integerShiftL# x w -- | Bitwise OR operation -- -- Fake 2's complement for negative values (might be slow) integerOr :: Integer -> Integer -> Integer -{-# NOINLINE integerOr #-} +{-# NOINLINE[0] integerOr #-} -- See Note [Integer constant folding] integerOr a b = case a of IS 0# -> b IS -1# -> IS -1# @@ -676,7 +703,7 @@ integerOr a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerXor :: Integer -> Integer -> Integer -{-# NOINLINE integerXor #-} +{-# NOINLINE[0] integerXor #-} -- See Note [Integer constant folding] integerXor a b = case a of IS 0# -> b IS -1# -> integerComplement b @@ -731,7 +758,7 @@ integerXor a b = case a of -- -- Fake 2's complement for negative values (might be slow) integerAnd :: Integer -> Integer -> Integer -{-# NOINLINE integerAnd #-} +{-# NOINLINE[0] integerAnd #-} -- See Note [Integer constant folding] integerAnd a b = case a of IS 0# -> IS 0# IS -1# -> b @@ -766,7 +793,7 @@ integerAnd a b = case a of -- | Binary complement of the integerComplement :: Integer -> Integer -{-# NOINLINE integerComplement #-} +{-# NOINLINE[0] integerComplement #-} -- See Note [Integer constant folding] integerComplement (IS x) = IS (notI# x) integerComplement (IP x) = IN (bigNatAddWord# x 1##) integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) @@ -777,7 +804,7 @@ integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerQuotRem# #-} +{-# NOINLINE[0] integerQuotRem# #-} -- See Note [Integer constant folding] integerQuotRem# !n (IS 1#) = (# n, IS 0# #) integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) integerQuotRem# !_ (IS 0#) = case raiseDivZero of @@ -815,12 +842,13 @@ integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerQuotRem :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerQuotRem #-} -- See Note [Integer constant folding] integerQuotRem !x !y = case integerQuotRem# x y of (# q, r #) -> (q, r) integerQuot :: Integer -> Integer -> Integer -{-# NOINLINE integerQuot #-} +{-# NOINLINE[0] integerQuot #-} -- See Note [Integer constant folding] integerQuot !n (IS 1#) = n integerQuot !n (IS -1#) = integerNegate n integerQuot !_ (IS 0#) = raiseDivZero @@ -841,7 +869,7 @@ integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q integerRem :: Integer -> Integer -> Integer -{-# NOINLINE integerRem #-} +{-# NOINLINE[0] integerRem #-} -- See Note [Integer constant folding] integerRem !_ (IS 1#) = IS 0# integerRem _ (IS -1#) = IS 0# integerRem _ (IS 0#) = IS (remInt# 0# 0#) @@ -863,7 +891,7 @@ integerRem n d = case integerQuotRem# n d of (# _, r #) -> r -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) -{-# NOINLINE integerDivMod# #-} +{-# NOINLINE[0] integerDivMod# #-} -- See Note [Integer constant folding] integerDivMod# !n !d | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) = let !q' = integerSub q (IS 1#) @@ -878,12 +906,13 @@ integerDivMod# !n !d -- Divisor must be non-zero otherwise the GHC runtime will terminate -- with a division-by-zero fault. integerDivMod :: Integer -> Integer -> (Integer, Integer) +{-# INLINE integerDivMod #-} -- See Note [Integer constant folding] integerDivMod !n !d = case integerDivMod# n d of (# q,r #) -> (q,r) integerDiv :: Integer -> Integer -> Integer -{-# NOINLINE integerDiv #-} +{-# NOINLINE[0] integerDiv #-} -- See Note [Integer constant folding] integerDiv !n !d -- same-sign ops can be handled by more efficient 'integerQuot' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d @@ -891,7 +920,7 @@ integerDiv !n !d integerMod :: Integer -> Integer -> Integer -{-# NOINLINE integerMod #-} +{-# NOINLINE[0] integerMod #-} -- See Note [Integer constant folding] integerMod !n !d -- same-sign ops can be handled by more efficient 'integerRem' | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d @@ -899,7 +928,7 @@ integerMod !n !d -- | Compute greatest common divisor. integerGcd :: Integer -> Integer -> Integer -{-# NOINLINE integerGcd #-} +{-# NOINLINE[0] integerGcd #-} -- See Note [Integer constant folding] integerGcd (IS 0#) !b = integerAbs b integerGcd a (IS 0#) = integerAbs a integerGcd (IS 1#) _ = IS 1# @@ -917,7 +946,7 @@ integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (ab -- | Compute least common multiple. integerLcm :: Integer -> Integer -> Integer -{-# NOINLINE integerLcm #-} +{-# NOINLINE[0] integerLcm #-} -- See Note [Integer constant folding] integerLcm (IS 0#) !_ = IS 0# integerLcm (IS 1#) b = integerAbs b integerLcm (IS -1#) b = integerAbs b @@ -931,6 +960,7 @@ integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab -- | Square a Integer integerSqr :: Integer -> Integer +{-# INLINE integerSqr #-} -- See Note [Integer constant folding] integerSqr !a = integerMul a a @@ -948,6 +978,7 @@ integerLog2# (IP b) = bigNatLog2# b -- -- For numbers <= 0, return 0 integerLog2 :: Integer -> Word +{-# INLINE integerLog2 #-} -- See Note [Integer constant folding] integerLog2 !i = W# (integerLog2# i) -- | Logarithm (floor) for an arbitrary base @@ -962,6 +993,7 @@ integerLogBaseWord# base !i -- -- For numbers <= 0, return 0 integerLogBaseWord :: Word -> Integer -> Word +{-# INLINE integerLogBaseWord #-} -- See Note [Integer constant folding] integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) -- | Logarithm (floor) for an arbitrary base @@ -977,6 +1009,7 @@ integerLogBase# !base !i -- -- For numbers <= 0, return 0 integerLogBase :: Integer -> Integer -> Word +{-# INLINE integerLogBase #-} -- See Note [Integer constant folding] integerLogBase !base !i = W# (integerLogBase# base i) -- | Indicate if the value is a power of two and which one @@ -991,7 +1024,7 @@ integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w -- | Convert an Int64# into an Integer on 32-bit architectures integerFromInt64# :: Int64# -> Integer -{-# NOINLINE integerFromInt64# #-} +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !i | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) &&# (i `geInt64#` intToInt64# -0x80000000#)) @@ -1005,7 +1038,7 @@ integerFromInt64# !i -- | Convert a Word64# into an Integer on 32-bit architectures integerFromWord64# :: Word64# -> Integer -{-# NOINLINE integerFromWord64# #-} +{-# NOINLINE[0] integerFromWord64# #-} -- See Note [Integer constant folding] integerFromWord64# !w | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) = IS (int64ToInt# (word64ToInt64# w)) @@ -1014,14 +1047,14 @@ integerFromWord64# !w -- | Convert an Integer into an Int64# on 32-bit architectures integerToInt64# :: Integer -> Int64# -{-# NOINLINE integerToInt64# #-} +{-# NOINLINE[0] integerToInt64# #-} -- See Note [Integer constant folding] integerToInt64# (IS i) = intToInt64# i integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) -- | Convert an Integer into a Word64# on 32-bit architectures integerToWord64# :: Integer -> Word64# -{-# NOINLINE integerToWord64# #-} +{-# NOINLINE[0] integerToWord64# #-} -- See Note [Integer constant folding] integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) integerToWord64# (IP b) = bigNatToWord64# b integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) @@ -1030,6 +1063,7 @@ integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatTo -- | Convert an Int64# into an Integer on 64-bit architectures integerFromInt64# :: Int# -> Integer +{-# NOINLINE[0] integerFromInt64# #-} -- See Note [Integer constant folding] integerFromInt64# !x = IS x #endif @@ -1040,18 +1074,19 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# NOINLINE[0] integerDecodeDouble# #-} -- See Note [Integer constant folding] integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble :: Double -> (Integer, Int) +{-# INLINE integerDecodeDouble #-} -- See Note [Integer constant folding] integerDecodeDouble (D# x) = case integerDecodeDouble# x of (# m, e #) -> (m, I# e) -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# -{-# NOINLINE integerEncodeDouble# #-} +{-# NOINLINE[0] integerEncodeDouble# #-} -- See Note [Integer constant folding] integerEncodeDouble# (IS i) 0# = int2Double# i integerEncodeDouble# (IS i) e = intEncodeDouble# i e integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e @@ -1059,23 +1094,24 @@ integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) -- | Encode (Integer mantissa, Int exponent) into a Double integerEncodeDouble :: Integer -> Int -> Double +{-# INLINE integerEncodeDouble #-} -- See Note [Integer constant folding] integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) -- | Encode an Integer (mantissa) into a Double# integerToDouble# :: Integer -> Double# -{-# NOINLINE integerToDouble# #-} +{-# NOINLINE[0] integerToDouble# #-} -- See Note [Integer constant folding] integerToDouble# !i = integerEncodeDouble# i 0# -- | Encode an Integer (mantissa) into a Float# integerToFloat# :: Integer -> Float# -{-# NOINLINE integerToFloat# #-} +{-# NOINLINE[0] integerToFloat# #-} -- See Note [Integer constant folding] integerToFloat# !i = integerEncodeFloat# i 0# -- | Encode (# Integer mantissa, Int# exponent #) into a Float# -- -- TODO: Not sure if it's worth to write 'Float' optimized versions here integerEncodeFloat# :: Integer -> Int# -> Float# -{-# NOINLINE integerEncodeFloat# #-} +{-# NOINLINE[0] integerEncodeFloat# #-} -- See Note [Integer constant folding] integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) @@ -1105,6 +1141,7 @@ integerToAddr# (IN n) = bigNatToAddr# n -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +{-# INLINE integerToAddr #-} -- See Note [Integer constant folding] integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of (# s', w #) -> (# s', W# w #) @@ -1132,6 +1169,7 @@ integerFromAddr# sz addr e s = -- -- Null higher limbs are automatically trimed. integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +{-# INLINE integerFromAddr #-} -- See Note [Integer constant folding] integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) @@ -1154,6 +1192,7 @@ integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a -- byte first (big-endian) if @1#@ or least significant byte first -- (little-endian) if @0#@. integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +{-# INLINE integerToMutableByteArray #-} -- See Note [Integer constant folding] integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of (# s', r #) -> (# s', W# r #) @@ -1180,6 +1219,7 @@ integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of -- -- Null higher limbs are automatically trimed. integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +{-# INLINE integerFromByteArray #-} -- See Note [Integer constant folding] integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of (# _, i #) -> i @@ -1212,5 +1252,36 @@ integerGcde :: Integer -> Integer -> ( Integer, Integer, Integer) +{-# INLINE integerGcde #-} -- See Note [Integer constant folding] integerGcde a b = case integerGcde# a b of (# g,x,y #) -> (g,x,y) + +{- Note [Integer constant folding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We define constant folding rules in "GHC.Core.Opt.ConstantFold" for most of the + at integer*#@ operations in this module, hence they are marked NOINLINE[0]. + +Why NOINLINE[0] rather than NOINLINE? Because + + 1. We still delay inlining long enough for the constant-folding RULEs + to fire + 2. The compiler has the option to inlining the operations late, possibly + cancelling away boxes in the process. + +Why NOINLINE[0] rather than INLINE? Because + + 3. We don't unconditionally inline huge definitions such as + `integerDiv`, which would lead to code bloat at pretty much no + gain. + 4. Since RULEs are unlikely to fire on the inlined RHS of e.g. + `integerDiv`, there is no gain in inlining the unoptimised + unfoldings. + +But since we potentially inline the constant folded operations in phase 0, we +have to make sure that *all* callers that want to take part in constant folding +are marked INLINE. Otherwise, we'd store optimised unfoldings for them, in which +the constant folded functions are inlined. +That concerns for most of the @integer*@ without trailing hash in this module, +as well as the type class instances for 'Eq', 'Ord', 'Num', 'Integral', +'RealFloat' (which is for 'Double'!), etc. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca238a084f13c1a4d412d33824568eeafe6cd06c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca238a084f13c1a4d412d33824568eeafe6cd06c You're receiving 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 30 17:17:27 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 13:17:27 -0400 Subject: [Git][ghc/ghc][wip/T18092] 950 commits: Switch order on `GhcMake.IsBoot` Message-ID: <5f74bda7b097d_80b3f8486c9011815667765@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18092 at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - ee3b0d7d by Sebastian Graf at 2020-09-30T19:17:17+02:00 Inline `decodeDoubleInteger` and constant-fold `decodeDouble_Int64#` instead Currently, `decodeDoubleInteger` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE`/`CONSTANT_FOLDED` things since #13143. Also it is a trade-off: The implementation of `decodeDoubleInteger` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `decodeDoubleInteger`. As a result, `decodeDoubleInteger` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. You may wonder how this affects performance of code using `integer-simple`; Apparently, according to @hsyl20 this is not a concern since we will hopefully land !2231 soon. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 20 changed files: - + .git-ignore-revs - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - + .gitlab/common.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - README.md - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - − compiler/GHC/Builtin/Names.hs-boot - 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/b08143695d1e38c458c3bc98a591420a653cb7cb...ee3b0d7d41a58462bcc0df63acbb146736c6c5df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b08143695d1e38c458c3bc98a591420a653cb7cb...ee3b0d7d41a58462bcc0df63acbb146736c6c5df You're receiving 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 30 17:20:38 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 30 Sep 2020 13:20:38 -0400 Subject: [Git][ghc/ghc][wip/T18092] Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Message-ID: <5f74be66c4d8b_80b3f841f5a5b30156685b0@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18092 at Glasgow Haskell Compiler / GHC Commits: 70734034 by Sebastian Graf at 2020-09-30T19:17:32+02:00 Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Currently, `integerDecodeDouble#` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE` things since #13143. Also it is a trade-off: The implementation of `integerDecodeDouble#` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `integerDecodeDouble#`. As a result, `integerDecodeDouble#` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. `integerDecodeDouble` is dead, so I deleted it. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 3 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/ghc-bignum/src/GHC/Num/Integer.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -379,7 +379,6 @@ basicKnownKeyNames integerToDoubleName, integerEncodeFloatName, integerEncodeDoubleName, - integerDecodeDoubleName, integerGcdName, integerLcmName, integerAndName, @@ -397,7 +396,6 @@ basicKnownKeyNames naturalRemName, naturalQuotRemName, bignatFromWordListName, - -- Float/Double rationalToFloatName, rationalToDoubleName, @@ -1155,7 +1153,6 @@ integerFromNaturalName , integerToDoubleName , integerEncodeFloatName , integerEncodeDoubleName - , integerDecodeDoubleName , integerGcdName , integerLcmName , integerAndName @@ -1223,7 +1220,6 @@ integerToFloatName = bniVarQual "integerToFloat#" integerToFloa integerToDoubleName = bniVarQual "integerToDouble#" integerToDoubleIdKey integerEncodeFloatName = bniVarQual "integerEncodeFloat#" integerEncodeFloatIdKey integerEncodeDoubleName = bniVarQual "integerEncodeDouble#" integerEncodeDoubleIdKey -integerDecodeDoubleName = bniVarQual "integerDecodeDouble#" integerDecodeDoubleIdKey integerGcdName = bniVarQual "integerGcd" integerGcdIdKey integerLcmName = bniVarQual "integerLcm" integerLcmIdKey integerAndName = bniVarQual "integerAnd" integerAndIdKey @@ -2466,7 +2462,6 @@ integerFromNaturalIdKey , integerFromWordIdKey , integerFromWord64IdKey , integerFromInt64IdKey - , integerDecodeDoubleIdKey , naturalToWordIdKey , naturalAddIdKey , naturalSubIdKey @@ -2518,7 +2513,6 @@ integerShiftRIdKey = mkPreludeMiscIdUnique 637 integerFromWordIdKey = mkPreludeMiscIdUnique 638 integerFromWord64IdKey = mkPreludeMiscIdUnique 639 integerFromInt64IdKey = mkPreludeMiscIdUnique 640 -integerDecodeDoubleIdKey = mkPreludeMiscIdUnique 641 naturalToWordIdKey = mkPreludeMiscIdUnique 650 naturalAddIdKey = mkPreludeMiscIdUnique 651 ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -13,8 +13,7 @@ ToDo: -} {-# LANGUAGE CPP, RankNTypes, PatternSynonyms, ViewPatterns, RecordWildCards, - DeriveFunctor #-} -{-# LANGUAGE LambdaCase #-} + DeriveFunctor, LambdaCase, TypeApplications #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-} module GHC.Core.Opt.ConstantFold @@ -244,32 +243,34 @@ primOpRules nm = \case DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] -- Float - FloatAddOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) - , identity zerof ] - FloatSubOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-)) - , rightIdentity zerof ] - FloatMulOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*)) - , identity onef - , strengthReduction twof FloatAddOp ] + FloatAddOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) + , identity zerof ] + FloatSubOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (-)) + , rightIdentity zerof ] + FloatMulOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (*)) + , identity onef + , strengthReduction twof FloatAddOp ] -- zeroElem zerof doesn't hold because of NaN - FloatDivOp -> mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/)) - , rightIdentity onef ] - FloatNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp - , inversePrimOp FloatNegOp ] + FloatDivOp -> mkPrimOpRule nm 2 [ guardFloatDiv >> binaryLit (floatOp2 (/)) + , rightIdentity onef ] + FloatNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp + , inversePrimOp FloatNegOp ] + FloatDecode_IntOp -> mkPrimOpRule nm 1 [ unaryLit floatDecodeOp ] -- Double - DoubleAddOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+)) - , identity zerod ] - DoubleSubOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-)) - , rightIdentity zerod ] - DoubleMulOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*)) - , identity oned - , strengthReduction twod DoubleAddOp ] + DoubleAddOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (+)) + , identity zerod ] + DoubleSubOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (-)) + , rightIdentity zerod ] + DoubleMulOp -> mkPrimOpRule nm 2 [ binaryLit (doubleOp2 (*)) + , identity oned + , strengthReduction twod DoubleAddOp ] -- zeroElem zerod doesn't hold because of NaN - DoubleDivOp -> mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/)) - , rightIdentity oned ] - DoubleNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp - , inversePrimOp DoubleNegOp ] + DoubleDivOp -> mkPrimOpRule nm 2 [ guardDoubleDiv >> binaryLit (doubleOp2 (/)) + , rightIdentity oned ] + DoubleNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp + , inversePrimOp DoubleNegOp ] + DoubleDecode_Int64Op -> mkPrimOpRule nm 1 [ unaryLit doubleDecodeOp ] -- Relational operators @@ -514,6 +515,15 @@ floatOp2 op env (LitFloat f1) (LitFloat f2) = Just (mkFloatVal env (f1 `op` f2)) floatOp2 _ _ _ _ = Nothing +-------------------------- +floatDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr +floatDecodeOp env (LitFloat ((decodeFloat . fromRational @Float) -> (m, e))) + = Just $ mkCoreUbxTup [intPrimTy, intPrimTy] + [ mkIntVal (roPlatform env) (toInteger m) + , mkIntVal (roPlatform env) (toInteger e) ] +floatDecodeOp _ _ + = Nothing + -------------------------- doubleOp2 :: (Rational -> Rational -> Rational) -> RuleOpts -> Literal -> Literal @@ -522,6 +532,22 @@ doubleOp2 op env (LitDouble f1) (LitDouble f2) = Just (mkDoubleVal env (f1 `op` f2)) doubleOp2 _ _ _ _ = Nothing +-------------------------- +doubleDecodeOp :: RuleOpts -> Literal -> Maybe CoreExpr +doubleDecodeOp env (LitDouble ((decodeFloat . fromRational @Double) -> (m, e))) + = Just $ mkCoreUbxTup [iNT64Ty, intPrimTy] + [ Lit (mkLitINT64 (roPlatform env) (toInteger m)) + , mkIntVal platform (toInteger e) ] + where + platform = roPlatform env + (iNT64Ty, mkLitINT64) + | platformWordSizeInBits platform < 64 + = (int64PrimTy, mkLitInt64Wrap) + | otherwise + = (intPrimTy , mkLitIntWrap) +doubleDecodeOp _ _ + = Nothing + -------------------------- {- Note [The litEq rule: converting equality to case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1336,7 +1362,6 @@ builtinBignumRules _ = , rule_encodeFloat "integerEncodeFloat" integerEncodeFloatName mkFloatLitFloat , rule_convert "integerToFloat" integerToFloatName (\_ -> mkFloatLitFloat) , rule_encodeFloat "integerEncodeDouble" integerEncodeDoubleName mkDoubleLitDouble - , rule_decodeDouble "integerDecodeDouble" integerDecodeDoubleName , rule_convert "integerToDouble" integerToDoubleName (\_ -> mkDoubleLitDouble) , rule_binopi "integerGcd" integerGcdName gcd , rule_binopi "integerLcm" integerLcmName lcm @@ -1411,9 +1436,6 @@ builtinBignumRules _ = rule_encodeFloat str name op = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2, ru_try = match_Integer_Int_encodeFloat op } - rule_decodeDouble str name - = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, - ru_try = match_decodeDouble } rule_passthrough str name toIntegerName = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, ru_try = match_passthrough toIntegerName } @@ -1747,22 +1769,6 @@ match_rationalTo mkLit _ id_unf _ [xl, yl] = Just (mkLit (fromRational (x % y))) match_rationalTo _ _ _ _ _ = Nothing -match_decodeDouble :: RuleFun -match_decodeDouble env id_unf fn [xl] - | Just (LitDouble x) <- exprIsLiteral_maybe id_unf xl - = case splitFunTy_maybe (idType fn) of - Just (_, _, res) - | Just [_lev1, _lev2, _integerTy, intHashTy] <- tyConAppArgs_maybe res - -> case decodeFloat (fromRational x :: Double) of - (y, z) -> - Just $ mkCoreUbxTup [integerTy, intHashTy] - [Lit (mkLitInteger y), - Lit (mkLitInt (roPlatform env) (toInteger z))] - _ -> - pprPanic "match_decodeDouble: Id has the wrong type" - (ppr fn <+> dcolon <+> ppr (idType fn)) -match_decodeDouble _ _ _ _ = Nothing - match_passthrough :: Name -> RuleFun match_passthrough n _ _ _ [App (Var x) y] | idName x == n ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -1040,15 +1040,11 @@ integerFromInt64# !x = IS x -- | Decode a Double# into (# Integer mantissa, Int# exponent #) integerDecodeDouble# :: Double# -> (# Integer, Int# #) -{-# NOINLINE integerDecodeDouble# #-} +{-# INLINE integerDecodeDouble# #-} -- decodeDouble_Int64# is constant-folded + -- in GHC.Core.Opt.ConstantFold integerDecodeDouble# !x = case decodeDouble_Int64# x of (# m, e #) -> (# integerFromInt64# m, e #) --- | Decode a Double# into (# Integer mantissa, Int# exponent #) -integerDecodeDouble :: Double -> (Integer, Int) -integerDecodeDouble (D# x) = case integerDecodeDouble# x of - (# m, e #) -> (m, I# e) - -- | Encode (# Integer mantissa, Int# exponent #) into a Double# integerEncodeDouble# :: Integer -> Int# -> Double# {-# NOINLINE integerEncodeDouble# #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7073403463b96a5be8903929aa0bc85cd1dfed20 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7073403463b96a5be8903929aa0bc85cd1dfed20 You're receiving 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 30 19:16:55 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 15:16:55 -0400 Subject: [Git][ghc/ghc][wip/strict-ttg] Fix test failures Message-ID: <5f74d9a75144b_80b8ce284c156866b5@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/strict-ttg at Glasgow Haskell Compiler / GHC Commits: 60eff54f by Vladislav Zavialov at 2020-09-30T22:16:43+03:00 Fix test failures - - - - - 15 changed files: - compiler/GHC/Hs/Expr.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/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Outputable.hs - testsuite/tests/parser/should_compile/T14189.stderr - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -2402,9 +2402,9 @@ pprStmt (LastStmt _ expr m_dollar_stripped _) Just False -> text "return" Nothing -> empty) <+> ppr expr -pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr] +pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds] -pprStmt (BodyStmt _ expr _ _) = ppr expr +pprStmt (BodyStmt _ expr _ _) = pprBodyStmt expr pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) pprStmt (TransStmt { trS_stmts = stmts, trS_by = by @@ -2439,10 +2439,9 @@ pprStmt (ApplicativeStmt _ args mb_join) flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc] flattenArg (_, ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL))] + [pprBodyStmt expr] | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))] + [pprBindStmt pat expr] flattenArg (_, ApplicativeArgMany _ stmts _ _ _) = concatMap flattenStmt stmts @@ -2456,6 +2455,11 @@ pprStmt (ApplicativeStmt _ args mb_join) pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc pp_arg (_, applicativeArg) = ppr applicativeArg +pprBodyStmt :: Outputable expr => expr -> SDoc +pprBodyStmt expr = ppr expr + +pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc +pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr] instance (OutputableBndrId idL) => Outputable (ApplicativeArg (GhcPass idL)) where @@ -2464,17 +2468,14 @@ instance (OutputableBndrId idL) pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc pprArg (ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL)) + pprBodyStmt expr | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL)) + pprBindStmt pat expr pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> - ppr (HsDo (panic "pprStmt") ctxt (noLoc - (stmts ++ - [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])) - :: HsExpr (GhcPass idL)) + pprDo ctxt (stmts ++ + [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -102,7 +102,7 @@ import GHC.Types.Basic import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Data.FastString -import GHC.Utils.Misc ( count ) +import GHC.Utils.Misc ( count, Box ) import Data.Data hiding ( Fixity, Prefix, Infix ) import Data.Maybe @@ -1690,7 +1690,8 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: !(XCFieldOcc pass) deriving instance Eq (XCFieldOcc (GhcPass p)) => Eq (FieldOcc (GhcPass p)) type instance XCFieldOcc GhcPs = NoExtField -type instance XCFieldOcc GhcRn = Name +type instance XCFieldOcc GhcRn = Box Name -- the Box is needed due to 'expectJust' in 'rnField' + -- TODO: refactor to remove it type instance XCFieldOcc GhcTc = Id type instance XXFieldOcc (GhcPass _) = NoExtCon ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -1135,7 +1135,7 @@ hsTyClForeignBinders tycl_decls foreign_decls foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls) where getSelectorNames :: ([Located Name], [LFieldOcc GhcRn]) -> [Name] - getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs + getSelectorNames (ns, fs) = map unLoc ns ++ map (unBox . extFieldOcc . unLoc) fs ------------------- hsLTyClDeclBinders :: IsPass p ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -24,6 +24,7 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Tc.Types +import GHC.Utils.Misc (unBox) import Control.Applicative import Data.Bifunctor (first) @@ -188,7 +189,7 @@ subordinates instMap decl = case decl of , maybeToList $ fmap unLoc $ con_doc c , conArgDocs c) | c <- cons, cname <- getConNames c ] - fields = [ (extFieldOcc n, maybeToList $ fmap unLoc doc, M.empty) + fields = [ (unBox (extFieldOcc n), maybeToList $ fmap unLoc doc, M.empty) | RecCon flds <- map getConArgs cons , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1633,7 +1633,7 @@ repFields (HsRecFields { rec_flds = flds }) where rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.FieldExp)) - rep_fld (L _ fld) = do { fn <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { fn <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; e <- repLE (hsRecFieldArg fld) ; repFieldExp fn e } @@ -1992,7 +1992,7 @@ repP (ConPat NoExtField dc details) } where rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat))) - rep_fld (L _ fld) = do { MkC v <- lookupLOcc (hsRecFieldSel fld) + rep_fld (L _ fld) = do { MkC v <- lookupLOcc (mapLoc unBox (hsRecFieldSel fld)) ; MkC p <- repLP (hsRecFieldArg fld) ; rep2 fieldPatName [v,p] } @@ -2626,7 +2626,7 @@ repConstr (RecCon ips) resTy cons rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip) rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType)) - rep_one_ip t n = do { MkC v <- lookupOcc (extFieldOcc $ unLoc n) + rep_one_ip t n = do { MkC v <- lookupOcc (unBox (extFieldOcc (unLoc n))) ; MkC ty <- repBangTy t ; rep2 varBangTypeName [v,ty] } ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -21,6 +21,7 @@ Main functions for .hie file generation module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, enrichHie) where +import GHC.Utils.Misc (Box(Box)) import GHC.Utils.Outputable(ppr) import GHC.Prelude @@ -1278,7 +1279,7 @@ instance ( ToHie (RFContext (Located label)) instance ToHie (RFContext (Located (FieldOcc GhcRn))) where toHie (RFC c rhs (L nspan f)) = concatM $ case f of - FieldOcc name _ -> + FieldOcc (Box name) _ -> [ toHie $ C (RecField c rhs) (L nspan name) ] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1174,7 +1174,7 @@ rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) where lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn lookupField (FieldOcc _ (L lr rdr)) = - FieldOcc (flSelector fl) (L lr rdr) + FieldOcc (Box (flSelector fl)) (L lr rdr) where lbl = occNameFS $ rdrNameOcc rdr fl = expectJust "rnField" $ lookupFsEnv fl_env lbl ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -654,7 +654,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) else return arg ; return (L l (HsRecField { hsRecFieldLbl = (L loc (FieldOcc - sel (L ll lbl))) + (Box sel) (L ll lbl))) , hsRecFieldArg = arg' , hsRecPun = pun })) } @@ -697,7 +697,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) ; addUsedGREs dot_dot_gres ; return [ L loc (HsRecField - { hsRecFieldLbl = L loc (FieldOcc sel (L loc arg_rdr)) + { hsRecFieldLbl = L loc (FieldOcc (Box sel) (L loc arg_rdr)) , hsRecFieldArg = L loc (mk_arg loc arg_rdr) , hsRecPun = False }) | fl <- dot_dot_fields @@ -792,7 +792,7 @@ rnHsRecUpdFields flds getFieldIds :: [LHsRecField GhcRn arg] -> [Name] -getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds +getFieldIds flds = map (unBox . unLoc . hsRecFieldSel . unLoc) flds getFieldLbls :: [LHsRecField id arg] -> [RdrName] getFieldLbls flds ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1429,7 +1429,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds , hsRecFieldArg = rhs })) = do { let lbl = rdrNameAmbiguousFieldOcc af sel_id = selectorAmbiguousFieldOcc af - f = L loc (FieldOcc (idName sel_id) (L loc lbl)) + f = L loc (FieldOcc (Box (idName sel_id)) (L loc lbl)) ; mb <- tcRecordField con_like flds_w_tys f rhs ; case mb of Nothing -> return Nothing @@ -1444,7 +1444,7 @@ tcRecordUpd con_like arg_tys rbinds = fmap catMaybes $ mapM do_bind rbinds tcRecordField :: ConLike -> Assoc Name Type -> LFieldOcc GhcRn -> LHsExpr GhcRn -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)) -tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs +tcRecordField con_like flds_w_tys (L loc (FieldOcc (Box sel_name) lbl)) rhs | Just field_ty <- assocMaybe flds_w_tys sel_name = addErrCtxt (fieldCtxt field_lbl) $ do { rhs' <- tcCheckPolyExprNC rhs field_ty @@ -1506,7 +1506,7 @@ checkMissingFields con_like rbinds field_strs = conLikeImplBangs con_like - fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds + fl `elemField` flds = any (\ fl' -> flSelector fl == unBox fl') flds {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1142,7 +1142,7 @@ tcConArgs con_like arg_tys penv con_args thing_inside = case con_args of tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn)) (LHsRecField GhcTc (LPat GhcTc)) tc_field penv - (L l (HsRecField (L loc (FieldOcc sel (L lr rdr))) pat pun)) + (L l (HsRecField (L loc (FieldOcc (Box sel) (L lr rdr))) pat pun)) thing_inside = do { sel' <- tcLookupId sel ; pat_ty <- setSrcSpan loc $ find_field_ty sel ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -904,7 +904,7 @@ mkOneRecordSelector all_cons idDetails fl rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField { hsRecFieldLbl - = L loc (FieldOcc sel_name + = L loc (FieldOcc (Box sel_name) (L loc $ mkVarUnqual lbl)) , hsRecFieldArg = L loc (VarPat noExtField (L loc field_var)) ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -7,6 +7,7 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -130,6 +131,9 @@ module GHC.Utils.Misc ( -- * Utils for flags OverridingBool(..), overrideWith, + + -- * Box + Box(Box, unBox), ) where #include "HsVersions.h" @@ -1476,3 +1480,12 @@ overrideWith :: Bool -> OverridingBool -> Bool overrideWith b Auto = b overrideWith _ Always = True overrideWith _ Never = False + +-- A wrapper to make a strict field into a lazy one. +data Box a = Box { unBox :: a } + deriving (Eq, Ord, Data) + +instance Show a => Show (Box a) where + showsPrec n (Box a) = showsPrec n a + show (Box a) = show a + showList xs = showList (map unBox xs) ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -126,6 +126,7 @@ import qualified Data.List.NonEmpty as NEL import GHC.Fingerprint import GHC.Show ( showMultiLineString ) import GHC.Utils.Exception +import GHC.Utils.Misc (Box(Box)) import GHC.Exts (oneShot) {- @@ -859,6 +860,9 @@ instance (Outputable a) => Outputable (NonEmpty a) where instance (Outputable a) => Outputable (Set a) where ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s)))) +instance Outputable a => Outputable (Box a) where + ppr (Box a) = ppr a + instance (Outputable a, Outputable b) => Outputable (a, b) where ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -78,7 +78,8 @@ (NoExtField) [({ T14189.hs:6:33 } (FieldOcc - {Name: T14189.f} + (Box + {Name: T14189.f}) ({ T14189.hs:6:33 } (Unqual {OccName: f}))))] ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit a18c3af7f983f3b6d3cd84093c9079031da58468 +Subproject commit 7ec18458ab0d289fc5936bb632c2065a7c01db90 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60eff54f397d3b5b29ea4ef50b47d6da6d18c395 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60eff54f397d3b5b29ea4ef50b47d6da6d18c395 You're receiving 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 30 19:33:33 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 15:33:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ttg-cleanup Message-ID: <5f74dd8d13dbf_80b3f8494187e341568722@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/ttg-cleanup at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ttg-cleanup You're receiving 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 30 20:37:11 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 16:37:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-rn-doc Message-ID: <5f74ec775ca11_80bda33d44157194f3@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/remove-rn-doc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-rn-doc You're receiving 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 30 21:05:40 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 30 Sep 2020 17:05:40 -0400 Subject: [Git][ghc/ghc][wip/ttg-cleanup] Minor TTG clean-up: comments, unused families, bottom Message-ID: <5f74f3245d405_80b3f84a02d747c15744596@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/ttg-cleanup at Glasgow Haskell Compiler / GHC Commits: 0cd0cece by Vladislav Zavialov at 2020-10-01T00:05:30+03:00 Minor TTG clean-up: comments, unused families, bottom 1. Fix and update section headers in GHC/Hs/Extension.hs 2. Delete the unused 'XCoreAnn' and 'XTickPragma' families 3. Avoid calls to 'panic' in 'pprStmt' - - - - - 2 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -847,7 +847,6 @@ data HsPragE p | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField -type instance XCoreAnn (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -2403,7 +2402,7 @@ pprStmt (LastStmt _ expr m_dollar_stripped _) Just False -> text "return" Nothing -> empty) <+> ppr expr -pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr] +pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds] pprStmt (BodyStmt _ expr _ _) = ppr expr pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) @@ -2439,11 +2438,8 @@ pprStmt (ApplicativeStmt _ args mb_join) flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc] flattenArg (_, ApplicativeArgOne _ pat expr isBody) - | isBody = -- See Note [Applicative BodyStmt] - [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL))] - | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))] + | isBody = [ppr expr] -- See Note [Applicative BodyStmt] + | otherwise = [pprBindStmt pat expr] flattenArg (_, ApplicativeArgMany _ stmts _ _ _) = concatMap flattenStmt stmts @@ -2457,6 +2453,8 @@ pprStmt (ApplicativeStmt _ args mb_join) pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc pp_arg (_, applicativeArg) = ppr applicativeArg +pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc +pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr] instance (OutputableBndrId idL) => Outputable (ApplicativeArg (GhcPass idL)) where @@ -2464,18 +2462,13 @@ instance (OutputableBndrId idL) pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc pprArg (ApplicativeArgOne _ pat expr isBody) - | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL)) - | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL)) + | isBody = ppr expr -- See Note [Applicative BodyStmt] + | otherwise = pprBindStmt pat expr pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> - ppr (HsDo (panic "pprStmt") ctxt (noLoc - (stmts ++ - [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])) - :: HsExpr (GhcPass idL)) + pprDo ctxt (stmts ++ + [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -331,11 +331,11 @@ type family XHsIPBinds x x' type family XEmptyLocalBinds x x' type family XXHsLocalBindsLR x x' --- ValBindsLR type families +-- HsValBindsLR type families type family XValBinds x x' type family XXValBindsLR x x' --- HsBindsLR type families +-- HsBindLR type families type family XFunBind x x' type family XPatBind x x' type family XVarBind x x' @@ -469,7 +469,7 @@ type family XCClsInstDecl x type family XXClsInstDecl x -- ------------------------------------- --- ClsInstDecl type families +-- InstDecl type families type family XClsInstD x type family XDataFamInstD x type family XTyFamInstD x @@ -490,7 +490,7 @@ type family XCDefaultDecl x type family XXDefaultDecl x -- ------------------------------------- --- DefaultDecl type families +-- ForeignDecl type families type family XForeignImport x type family XForeignExport x type family XXForeignDecl x @@ -517,7 +517,7 @@ type family XWarnings x type family XXWarnDecls x -- ------------------------------------- --- AnnDecl type families +-- WarnDecl type families type family XWarning x type family XXWarnDecl x @@ -574,32 +574,34 @@ type family XBinTick x type family XPragE x type family XXExpr x +-- ------------------------------------- +-- HsPragE type families type family XSCC x -type family XCoreAnn x -type family XTickPragma x type family XXPragE x --- --------------------------------------------------------------------- + +-- ------------------------------------- +-- AmbiguousFieldOcc type families type family XUnambiguous x type family XAmbiguous x type family XXAmbiguousFieldOcc x --- ---------------------------------------------------------------------- - +-- ------------------------------------- +-- HsTupArg type families type family XPresent x type family XMissing x type family XXTupArg x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsSplice type families type family XTypedSplice x type family XUntypedSplice x type family XQuasiQuote x type family XSpliced x type family XXSplice x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsBracket type families type family XExpBr x type family XPatBr x type family XDecBrL x @@ -609,33 +611,33 @@ type family XVarBr x type family XTExpBr x type family XXBracket x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsCmdTop type families type family XCmdTop x type family XXCmdTop x -- ------------------------------------- - +-- MatchGroup type families type family XMG x b type family XXMatchGroup x b -- ------------------------------------- - +-- Match type families type family XCMatch x b type family XXMatch x b -- ------------------------------------- - +-- GRHSs type families type family XCGRHSs x b type family XXGRHSs x b -- ------------------------------------- - +-- GRHS type families type family XCGRHS x b type family XXGRHS x b -- ------------------------------------- - +-- StmtLR type families type family XLastStmt x x' b type family XBindStmt x x' b type family XApplicativeStmt x x' b @@ -646,8 +648,8 @@ type family XTransStmt x x' b type family XRecStmt x x' b type family XXStmtLR x x' b --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- HsCmd type families type family XCmdArrApp x type family XCmdArrForm x type family XCmdApp x @@ -661,13 +663,13 @@ type family XCmdDo x type family XCmdWrap x type family XXCmd x --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- ParStmtBlock type families type family XParStmtBlock x x' type family XXParStmtBlock x x' --- --------------------------------------------------------------------- - +-- ------------------------------------- +-- ApplicativeArg type families type family XApplicativeArgOne x type family XApplicativeArgMany x type family XXApplicativeArg x @@ -697,6 +699,8 @@ type family XHsFloatPrim x type family XHsDoublePrim x type family XXLit x +-- ------------------------------------- +-- HsOverLit type families type family XOverLit x type family XXOverLit x @@ -725,26 +729,29 @@ type family XXPat x -- ===================================================================== -- Type families for the HsTypes type families + +-- ------------------------------------- +-- LHsQTyVars type families type family XHsQTvs x type family XXLHsQTyVars x -- ------------------------------------- - +-- HsImplicitBndrs type families type family XHsIB x b type family XXHsImplicitBndrs x b -- ------------------------------------- - +-- HsWildCardBndrs type families type family XHsWC x b type family XXHsWildCardBndrs x b -- ------------------------------------- - +-- HsPatSigType type families type family XHsPS x type family XXHsPatSigType x -- ------------------------------------- - +-- HsType type families type family XForAllTy x type family XQualTy x type family XTyVar x @@ -770,35 +777,37 @@ type family XWildCardTy x type family XXType x -- --------------------------------------------------------------------- - +-- HsForAllTelescope type families type family XHsForAllVis x type family XHsForAllInvis x type family XXHsForAllTelescope x -- --------------------------------------------------------------------- - +-- HsTyVarBndr type families type family XUserTyVar x type family XKindedTyVar x type family XXTyVarBndr x -- --------------------------------------------------------------------- - +-- ConDeclField type families type family XConDeclField x type family XXConDeclField x -- --------------------------------------------------------------------- - +-- FieldOcc type families type family XCFieldOcc x type family XXFieldOcc x -- ===================================================================== -- Type families for the HsImpExp type families +-- ------------------------------------- +-- ImportDecl type families type family XCImportDecl x type family XXImportDecl x -- ------------------------------------- - +-- IE type families type family XIEVar x type family XIEThingAbs x type family XIEThingAll x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cd0cece24b23d74c677ab04942f615852520734 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cd0cece24b23d74c677ab04942f615852520734 You're receiving 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 30 21:28:47 2020 From: gitlab at gitlab.haskell.org (Adam Gundry) Date: Wed, 30 Sep 2020 17:28:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/amg/no-ambiguous-fields Message-ID: <5f74f88feea1f_80b3f846916920c15750074@gitlab.haskell.org.mail> Adam Gundry pushed new branch wip/amg/no-ambiguous-fields at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/amg/no-ambiguous-fields You're receiving 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 30 22:17:14 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Wed, 30 Sep 2020 18:17:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/ghc-9.0-gadt-parens Message-ID: <5f7503eac1c52_80bd44ebcc157758dc@gitlab.haskell.org.mail> Alan Zimmerman pushed new branch wip/az/ghc-9.0-gadt-parens at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/ghc-9.0-gadt-parens You're receiving 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 30 22:47:32 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Wed, 30 Sep 2020 18:47:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/master-gadt-parens Message-ID: <5f750b045a131_80b3f8468d76474157778f9@gitlab.haskell.org.mail> Alan Zimmerman pushed new branch wip/az/master-gadt-parens at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/master-gadt-parens You're receiving 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 30 23:15:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 19:15:27 -0400 Subject: [Git][ghc/ghc][wip/testing] 1463 commits: improve docs for HeaderInfo.getImports Message-ID: <5f75118facd40_80b3f846985b5b0157786ee@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/testing at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04: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 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04: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 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04: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. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04: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. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04: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 and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-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. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-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. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-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 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04: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. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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) points (2,3)) 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 (see #16320). 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 That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * 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 Updates haddock submodule. 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) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04: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 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 4b5b9f77 by Ben Gamari at 2020-09-30T19:15:13-04:00 testing - - - - - 19 changed files: - .ghcid - + .git-ignore-revs - .gitignore - .gitlab-ci.yml - + .gitlab/ci.sh - + .gitlab/common.sh - − .gitlab/darwin-init.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - .gitlab/test-metrics.sh - − .gitlab/win32-init.sh - .gitmodules - CODEOWNERS - HACKING.md - Makefile - README.md - aclocal.m4 - boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0f65866bf54e01174f9dd3312a7318db597b846...4b5b9f7712cc8f7d5bb60ee037800e2d75e6d0be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0f65866bf54e01174f9dd3312a7318db597b846...4b5b9f7712cc8f7d5bb60ee037800e2d75e6d0be You're receiving 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 30 23:16:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 19:16:23 -0400 Subject: [Git][ghc/ghc][wip/testing] testing Message-ID: <5f7511c7254f9_80b3f8486531e081578024f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/testing at Glasgow Haskell Compiler / GHC Commits: 8f3a4004 by Ben Gamari at 2020-09-30T19:16:17-04:00 testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -382,9 +382,10 @@ release-x86_64-freebsd: validate-x86_64-darwin: extends: .validate - stage: full-build + stage: lint tags: - x86_64-darwin + - testing variables: GHC_VERSION: 8.8.4 CABAL_INSTALL_VERSION: 3.0.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f3a40044519d3584c861d7612952db95c2ee72e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f3a40044519d3584c861d7612952db95c2ee72e You're receiving 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 30 23:18:17 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 19:18:17 -0400 Subject: [Git][ghc/ghc][wip/testing] testing Message-ID: <5f75123986a0c_80b3f848686e1c0157807a9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/testing at Glasgow Haskell Compiler / GHC Commits: b33003d5 by Ben Gamari at 2020-09-30T19:18:10-04:00 testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -282,6 +282,8 @@ hadrian-ghc-in-ghci: TEST_TYPE: test MAKE_ARGS: "-Werror" script: + - "echo $PATH" + - which autoreconf - .gitlab/ci.sh setup - .gitlab/ci.sh configure - .gitlab/ci.sh build_make @@ -382,9 +384,10 @@ release-x86_64-freebsd: validate-x86_64-darwin: extends: .validate - stage: full-build + stage: lint tags: - x86_64-darwin + - testing variables: GHC_VERSION: 8.8.4 CABAL_INSTALL_VERSION: 3.0.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b33003d513d210c878aa3aae2639497470701a7c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b33003d513d210c878aa3aae2639497470701a7c You're receiving 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 30 23:46:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 19:46:53 -0400 Subject: [Git][ghc/ghc][wip/testing] testing Message-ID: <5f7518ed1ab30_80b3f849626bc0415782027@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/testing at Glasgow Haskell Compiler / GHC Commits: 8f94eb50 by Ben Gamari at 2020-09-30T19:46:46-04:00 testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -282,6 +282,9 @@ hadrian-ghc-in-ghci: TEST_TYPE: test MAKE_ARGS: "-Werror" script: + - "echo $PATH" + - "echo $SHELL" + - which autoreconf - .gitlab/ci.sh setup - .gitlab/ci.sh configure - .gitlab/ci.sh build_make @@ -382,9 +385,10 @@ release-x86_64-freebsd: validate-x86_64-darwin: extends: .validate - stage: full-build + stage: lint tags: - x86_64-darwin + - testing variables: GHC_VERSION: 8.8.4 CABAL_INSTALL_VERSION: 3.0.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f94eb5070ba97da6b8053b46c75c5c6d9797521 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f94eb5070ba97da6b8053b46c75c5c6d9797521 You're receiving 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 30 23:56:12 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 30 Sep 2020 19:56:12 -0400 Subject: [Git][ghc/ghc][wip/testing] testing Message-ID: <5f751b1ca1eed_80b3f848b27b81c1578424e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/testing at Glasgow Haskell Compiler / GHC Commits: d7508db5 by Ben Gamari at 2020-09-30T19:56:07-04:00 testing - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -282,6 +282,10 @@ hadrian-ghc-in-ghci: TEST_TYPE: test MAKE_ARGS: "-Werror" script: + - source $HOME/.zshrc + - "echo $PATH" + - "echo $SHELL" + - which autoreconf - .gitlab/ci.sh setup - .gitlab/ci.sh configure - .gitlab/ci.sh build_make @@ -382,9 +386,10 @@ release-x86_64-freebsd: validate-x86_64-darwin: extends: .validate - stage: full-build + stage: lint tags: - x86_64-darwin + - testing variables: GHC_VERSION: 8.8.4 CABAL_INSTALL_VERSION: 3.0.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7508db55786c2a6f4471f8547d66c28c6bfe20a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7508db55786c2a6f4471f8547d66c28c6bfe20a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: